From 82e06dab9e01981097e111d3a4de6acd3a0dc50e Mon Sep 17 00:00:00 2001
From: Sebastien Mondet <seb@mondet.org>
Date: Fri, 11 Jan 2019 14:42:46 -0500
Subject: [PATCH] Tests: add OCaml framewwork flextesa

---
 .gitignore                                    |   1 +
 .gitlab-ci.yml                                |  75 +-
 Makefile                                      |   6 +-
 docs/tutorials/flextesa.rst                   | 173 +++++
 scripts/version.sh                            |   2 +-
 src/bin_flextesa/.ocamlformat                 |   1 +
 src/bin_flextesa/command_accusations.ml       | 678 ++++++++++++++++++
 src/bin_flextesa/command_mini_network.ml      | 120 ++++
 src/bin_flextesa/command_prevalidation.ml     |  36 +
 src/bin_flextesa/command_voting.ml            | 516 +++++++++++++
 src/bin_flextesa/dune                         |  50 ++
 src/bin_flextesa/flextesa.opam                |  20 +
 src/bin_flextesa/main.ml                      |  78 ++
 src/lib_network_sandbox/.ocamlformat          |   1 +
 src/lib_network_sandbox/console.ml            | 232 ++++++
 src/lib_network_sandbox/console.mli           |  80 +++
 src/lib_network_sandbox/dune                  |  16 +
 src/lib_network_sandbox/helpers.ml            |  85 +++
 src/lib_network_sandbox/helpers.mli           |  58 ++
 src/lib_network_sandbox/interactive_test.ml   | 492 +++++++++++++
 src/lib_network_sandbox/interactive_test.mli  | 194 +++++
 .../internal_pervasives.ml                    | 272 +++++++
 src/lib_network_sandbox/kiln.ml               | 119 +++
 src/lib_network_sandbox/kiln.mli              |  38 +
 src/lib_network_sandbox/log_recorder.ml       |  45 ++
 src/lib_network_sandbox/paths.ml              |  18 +
 src/lib_network_sandbox/paths.mli             |  12 +
 src/lib_network_sandbox/running_processes.ml  | 259 +++++++
 src/lib_network_sandbox/running_processes.mli |  97 +++
 src/lib_network_sandbox/test_command_line.ml  |  51 ++
 src/lib_network_sandbox/test_command_line.mli |  29 +
 src/lib_network_sandbox/test_scenario.ml      | 325 +++++++++
 src/lib_network_sandbox/test_scenario.mli     | 134 ++++
 .../tezos-network-sandbox.opam                |  25 +
 src/lib_network_sandbox/tezos_admin_client.ml |  47 ++
 .../tezos_admin_client.mli                    |  35 +
 src/lib_network_sandbox/tezos_client.ml       | 276 +++++++
 src/lib_network_sandbox/tezos_client.mli      | 188 +++++
 src/lib_network_sandbox/tezos_daemon.ml       |  58 ++
 src/lib_network_sandbox/tezos_daemon.mli      |  40 ++
 src/lib_network_sandbox/tezos_executable.ml   |  69 ++
 src/lib_network_sandbox/tezos_executable.mli  |  54 ++
 src/lib_network_sandbox/tezos_node.ml         | 131 ++++
 src/lib_network_sandbox/tezos_node.mli        |  48 ++
 src/lib_network_sandbox/tezos_protocol.ml     | 339 +++++++++
 src/lib_network_sandbox/tezos_protocol.mli    | 110 +++
 46 files changed, 5716 insertions(+), 17 deletions(-)
 create mode 100644 docs/tutorials/flextesa.rst
 create mode 100644 src/bin_flextesa/.ocamlformat
 create mode 100644 src/bin_flextesa/command_accusations.ml
 create mode 100644 src/bin_flextesa/command_mini_network.ml
 create mode 100644 src/bin_flextesa/command_prevalidation.ml
 create mode 100644 src/bin_flextesa/command_voting.ml
 create mode 100644 src/bin_flextesa/dune
 create mode 100644 src/bin_flextesa/flextesa.opam
 create mode 100644 src/bin_flextesa/main.ml
 create mode 100644 src/lib_network_sandbox/.ocamlformat
 create mode 100644 src/lib_network_sandbox/console.ml
 create mode 100644 src/lib_network_sandbox/console.mli
 create mode 100644 src/lib_network_sandbox/dune
 create mode 100644 src/lib_network_sandbox/helpers.ml
 create mode 100644 src/lib_network_sandbox/helpers.mli
 create mode 100644 src/lib_network_sandbox/interactive_test.ml
 create mode 100644 src/lib_network_sandbox/interactive_test.mli
 create mode 100644 src/lib_network_sandbox/internal_pervasives.ml
 create mode 100644 src/lib_network_sandbox/kiln.ml
 create mode 100644 src/lib_network_sandbox/kiln.mli
 create mode 100644 src/lib_network_sandbox/log_recorder.ml
 create mode 100644 src/lib_network_sandbox/paths.ml
 create mode 100644 src/lib_network_sandbox/paths.mli
 create mode 100644 src/lib_network_sandbox/running_processes.ml
 create mode 100644 src/lib_network_sandbox/running_processes.mli
 create mode 100644 src/lib_network_sandbox/test_command_line.ml
 create mode 100644 src/lib_network_sandbox/test_command_line.mli
 create mode 100644 src/lib_network_sandbox/test_scenario.ml
 create mode 100644 src/lib_network_sandbox/test_scenario.mli
 create mode 100644 src/lib_network_sandbox/tezos-network-sandbox.opam
 create mode 100644 src/lib_network_sandbox/tezos_admin_client.ml
 create mode 100644 src/lib_network_sandbox/tezos_admin_client.mli
 create mode 100644 src/lib_network_sandbox/tezos_client.ml
 create mode 100644 src/lib_network_sandbox/tezos_client.mli
 create mode 100644 src/lib_network_sandbox/tezos_daemon.ml
 create mode 100644 src/lib_network_sandbox/tezos_daemon.mli
 create mode 100644 src/lib_network_sandbox/tezos_executable.ml
 create mode 100644 src/lib_network_sandbox/tezos_executable.mli
 create mode 100644 src/lib_network_sandbox/tezos_node.ml
 create mode 100644 src/lib_network_sandbox/tezos_node.mli
 create mode 100644 src/lib_network_sandbox/tezos_protocol.ml
 create mode 100644 src/lib_network_sandbox/tezos_protocol.mli

diff --git a/.gitignore b/.gitignore
index 5de7a10fe422..bbf3370bf11d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -24,6 +24,7 @@ __pycache__
 /tezos-endorser-*
 /tezos-accuser-*
 /tezos-signer
+/tezos-sandbox
 
 /scripts/opam-test-all.sh.DONE
 /scripts/create_genesis/src
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 10107d874aa5..2d151c8ea253 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -1,6 +1,6 @@
 variables:
   ## Please update `scripts/version.sh` accordingly
-  build_deps_image_version: ebc2de016e52e8b77f250df174512a793b2fb0e5
+  build_deps_image_version: fdc1ab3f23d1601f00a2165e02fcd9fa3ddd8514
   build_deps_image_name: registry.gitlab.com/tezos/opam-repository
   public_docker_image_name: docker.io/${CI_PROJECT_PATH}
 
@@ -226,6 +226,41 @@ test:proto:sandbox:
   script:
     - dune build @runtest_sandbox
 
+############################################################
+## Stage: run OCaml integration tests                     ##
+############################################################
+
+test:sandboxes:voting:
+  <<: *integration_definition
+  script:
+    - ROOT_PATH=$PWD/flextesa-voting-demo dune build @src/bin_flextesa/runtest_sandbox_voting_demo
+  artifacts:
+    paths:
+    - flextesa-voting-demo
+    expire_in: 1 day
+    when: on_failure
+  allow_failure: true # This test uses too much resources for GitLab's workers
+
+test:sandboxes:acc-baking:
+  <<: *integration_definition
+  script:
+    - ROOT_PATH=$PWD/flextesa-acc-sdb dune build @src/bin_flextesa/runtest_sandbox_accusations_simple_double_baking
+  artifacts:
+    paths:
+    - flextesa-acc-sdb
+    expire_in: 1 day
+    when: on_failure
+
+test:sandboxes:acc-endorsement:
+  <<: *integration_definition
+  script:
+    - ROOT_PATH=$PWD/flextesa-acc-sde dune build @src/bin_flextesa/runtest_sandbox_accusations_simple_double_endorsing
+  artifacts:
+    paths:
+    - flextesa-acc-sde
+    expire_in: 1 day
+    when: on_failure
+
 ############################################################
 ## Stage: run python integration tests                    ##
 ############################################################
@@ -589,72 +624,82 @@ opam:50:ocplib-ezresto:
   variables:
     package: ocplib-ezresto
 
-opam:51:tezos-embedded-protocol-alpha:
+opam:51:tezos-network-sandbox:
+  <<: *opam_definition
+  variables:
+    package: tezos-network-sandbox
+
+opam:52:tezos-embedded-protocol-alpha:
   <<: *opam_definition
   variables:
     package: tezos-embedded-protocol-alpha
 
-opam:52:tezos-embedded-protocol-demo:
+opam:53:tezos-embedded-protocol-demo:
   <<: *opam_definition
   variables:
     package: tezos-embedded-protocol-demo
 
-opam:53:tezos-embedded-protocol-genesis:
+opam:54:tezos-embedded-protocol-genesis:
   <<: *opam_definition
   variables:
     package: tezos-embedded-protocol-genesis
 
-opam:54:tezos-shell:
+opam:55:tezos-shell:
   <<: *opam_definition
   variables:
     package: tezos-shell
 
-opam:55:tezos-endorser-alpha-commands:
+opam:56:tezos-endorser-alpha-commands:
   <<: *opam_definition
   variables:
     package: tezos-endorser-alpha-commands
 
-opam:56:tezos-client:
+opam:57:tezos-client:
   <<: *opam_definition
   variables:
     package: tezos-client
 
-opam:57:ocplib-ezresto-directory:
+opam:58:ocplib-ezresto-directory:
   <<: *opam_definition
   variables:
     package: ocplib-ezresto-directory
 
-opam:58:tezos-accuser-alpha:
+opam:59:tezos-accuser-alpha:
   <<: *opam_definition
   variables:
     package: tezos-accuser-alpha
 
-opam:59:tezos-endorser-alpha:
+opam:60:flextesa:
+  <<: *opam_definition
+  variables:
+    package: flextesa
+
+opam:61:tezos-endorser-alpha:
   <<: *opam_definition
   variables:
     package: tezos-endorser-alpha
 
-opam:60:tezos-accuser-alpha-commands:
+opam:62:tezos-accuser-alpha-commands:
   <<: *opam_definition
   variables:
     package: tezos-accuser-alpha-commands
 
-opam:61:tezos-baker-alpha:
+opam:63:tezos-baker-alpha:
   <<: *opam_definition
   variables:
     package: tezos-baker-alpha
 
-opam:62:tezos-signer:
+opam:64:tezos-signer:
   <<: *opam_definition
   variables:
     package: tezos-signer
 
-opam:63:tezos-node:
+opam:65:tezos-node:
   <<: *opam_definition
   variables:
     package: tezos-node
 
-opam:64:ocplib-json-typed-browser:
+opam:66:ocplib-json-typed-browser:
   <<: *opam_definition
   variables:
     package: ocplib-json-typed-browser
diff --git a/Makefile b/Makefile
index fb45396e53ca..8a2b60e79fe3 100644
--- a/Makefile
+++ b/Makefile
@@ -78,7 +78,11 @@ doc-html: all
 doc-html-and-linkcheck: doc-html
 	@${MAKE} -C docs all
 
-build-test:
+build-sandbox:
+	@dune build src/bin_flextesa/main.exe
+	@cp _build/default/src/bin_flextesa/main.exe tezos-sandbox
+
+build-test: build-sandbox
 	@dune build @buildtest
 
 test:
diff --git a/docs/tutorials/flextesa.rst b/docs/tutorials/flextesa.rst
new file mode 100644
index 000000000000..4d6ca9f74aa2
--- /dev/null
+++ b/docs/tutorials/flextesa.rst
@@ -0,0 +1,173 @@
+Flexible Network Sandboxes
+==========================
+
+Build
+-----
+
+Use:
+
+::
+
+    make build-sandbox
+
+(or ``make build-test``).
+
+There are testing-only ``opam`` dependencies: ``dum`` and ``genspio``
+(``0.0.2``), make sure you have done ``make build-deps``.
+
+Usage
+-----
+
+See ``./tezos-sandbox --help`` (or one can use
+``_build/default/src/bin_flextesa/main.exe``).
+
+When running (semi-)interactive tests, it is recommended to wrap the
+call with ``rlwrap`` or ``ledit``.
+
+Examples
+--------
+
+Mini-Network
+~~~~~~~~~~~~
+
+One can run a mini-network advancing fast with accusers, bakers, and
+endorsers:
+
+::
+
+    rlwrap ./tezos-sandbox mini-network \
+           --root-path /tmp/zz-mininet-test \
+           --tezos-node-binary _build/default/src/bin_node/main.exe \
+           --tezos-baker-alpha-binary _build/default/src/proto_alpha/bin_baker/main_baker_alpha.exe \
+           --tezos-endorser-alpha-binary _build/default/src/proto_alpha/bin_endorser/main_endorser_alpha.exe \
+           --tezos-accuser-alpha-binary _build/default/src/proto_alpha/bin_accuser/main_accuser_alpha.exe \
+           --tezos-client-binary _build/default/src/bin_client/main_client.exe
+
+Once the network is started this test scenario becomes interactive:
+
+::
+
+    Flextesa.mininet: Please enter command:
+
+Just try ``h`` (or ``help``) to see the available commands.
+
+Double Endorsement Accusation
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+There are 3 “accusation scenarios” so far, see
+``./tezos-sandbox accusation --help``. For instance, the following command
+starts a small 3-node network, forces one baker to endorse two
+concurrent branches, and then makes another baker inject (and bake) the
+double-endorsement-evidence operation. The option ``--base-port=20_000``
+tells ``tezos-sandbox`` to start allocating P2P/RPC ports from 20 000 and
+``--pause-at-end=true`` tells ``tezos-sandbox`` to enter an interactive
+command prompt at the end of the test to give a chance to explore the
+sandbox before killing all the nodes.
+
+::
+
+    rlwrap ./tezos-sandbox accusations simple-double-endorsing \
+         --root $PWD/double-endorsing-test \
+         --base-port=20_000 \
+         --pause-at-end=true
+         
+
+This test among other ones can run
+`Kiln <https://gitlab.com/obsidian.systems/tezos-bake-monitor/>`__
+alongside the *Ꜩ-sandbox*, for instance:
+
+::
+
+    rlwrap ./tezos-sandbox accusations simple-double-endorsing --with-kiln
+
+See also the options ``--kiln-*`` for configuration, and the option
+``--starting-level`` (since Kiln assumes a long-running blockchain
+adding more, e.g. 40, bakes at the beginning of the test brings us to a
+more “normal” state).
+
+Voting With a Ledger Nano S
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+    **Note:** this requires a ``tezos-client`` with the changes from
+    https://gitlab.com/tezos/tezos/merge_requests/848.
+
+The voting test for now goes up to the last block before the protocol is
+supposed to change to the election winner (see also
+``./tezos-sandbox voting --help``).
+
+The test can use a Ledger Nano S as one of the voters (the test
+automatically becomes **interactive** then because the user has to press
+buttons on the device).
+
+Get an URI for your ledger (the test requires both the Wallet and Baking
+apps):
+
+::
+
+    tezos-client list connected ledgers
+
+And use the URI (no need to import it) for the ``--with-ledger`` option:
+
+::
+
+    rlwrap ./tezos-sandbox voting ./src/bin_client/test/demo/ \
+         --with-ledger "ledger://crouching-tiger-hidden-dragon/ed25519/0'/0'" \
+         --serialize-proposals \
+         --root $PWD/voting-test \
+         --base-port=20_000 \
+         --tezos-client-binary ../mr848/tezos-client \
+         --pause-on-error=true
+
+The test becomes interactive and guides you through the interactions
+with the ledger, e.g.:
+
+::
+
+    Flextesa.voting:
+      Ledger-prompt 
+        
+          Setting up "ledger://crouching-tiger-hidden-dragon/ed25519/0'/0'" for
+          baking. The ledger should be showing the setup parameters (Address,
+          Main chain, HWMs).
+        
+         Please hit “✔” on the ledger. 
+
+Implementation Considerations
+-----------------------------
+
+``Running_processes`` is very high-level (actually agnostic to Tezos).
+Most processes are actually calls to ``sh -c <script>`` where
+``<script>`` is the result of a ``Genspio`` compilation, this leaves the
+option to later easily run some processes over SSH (without OCaml
+dependencies on the destination host) or in special containers (e.g.
+``docker run --cpu-shares ...``).
+
+The prompt commands for interactive use use ``Base.Sexp.t`` parsers
+(because already a dependency, and we need a good string literal parser
+so we cannot use ``Clic`` nor ``Cmdliner``).
+
+Special Coding Style
+--------------------
+
+A fresh “just for testing project” is a good occasion to experiment a
+bit …
+
+See ``./src/lib_network_sandbox/internal_pervasives.ml``:
+
+-  ``EF``: we try to use combinators on top of
+   `Easy-format <https://mjambon.github.io/mjambon2016/easy-format.html>`__
+   for most pretty-printing (it is still compatible with ``Format`` but
+   it is much more functional/composable and does not rely on
+   ``@[<2,3>@{crazy}@ @<acronym>EDSLs@n@]``).
+-  Many standard modules are taken from Jane St Base (already a
+   dependency of Tezos): List, String, Option, Int, Float.
+-  Error monad uses *more typed* errors (polymorphic variants), cf.
+   module ``Asynchronous_result`` (and note that ``bind`` also calls
+   ``Lwt_unix.auto_yield 0.005 ()``).
+-  All state is kept in a (*non-global*) value passed as argument
+   everywhere needed. To simplify the dependency management the state
+   variables are objects (cf. ``Base_state``, then ``Paths``,
+   ``Console``, etc).
+
+Also, everything uses OCamlFormat instead of ``ocp-indent`` (see
+``./.ocamlformat``).
diff --git a/scripts/version.sh b/scripts/version.sh
index 2c54a7039d32..562177b5b5de 100644
--- a/scripts/version.sh
+++ b/scripts/version.sh
@@ -7,7 +7,7 @@ ocaml_version=4.07.1
 opam_version=2.0
 
 ## Please update `.gitlab-ci.yml` accordingly
-opam_repository_tag=ebc2de016e52e8b77f250df174512a793b2fb0e5
+opam_repository_tag=fdc1ab3f23d1601f00a2165e02fcd9fa3ddd8514
 full_opam_repository_tag=2952acf6c0736562d1a94c3fd28ff01a8c38d56b
 opam_repository_url=https://gitlab.com/tezos/opam-repository.git
 opam_repository=$opam_repository_url\#$opam_repository_tag
diff --git a/src/bin_flextesa/.ocamlformat b/src/bin_flextesa/.ocamlformat
new file mode 100644
index 000000000000..a3d97274f48f
--- /dev/null
+++ b/src/bin_flextesa/.ocamlformat
@@ -0,0 +1 @@
+profile=compact
\ No newline at end of file
diff --git a/src/bin_flextesa/command_accusations.ml b/src/bin_flextesa/command_accusations.ml
new file mode 100644
index 000000000000..ebf9a368b8ab
--- /dev/null
+++ b/src/bin_flextesa/command_accusations.ml
@@ -0,0 +1,678 @@
+open Tezos_network_sandbox
+open Internal_pervasives
+open Console
+
+let default_attempts = 35
+
+let little_mesh_with_bakers ?base_port ?kiln state ~starting_level ~node_exec
+    ~client_exec ~bakers () =
+  Helpers.clear_root state
+  >>= fun () ->
+  Interactive_test.Pauser.generic state
+    EF.[af "Ready to start"; af "Root path deleted."]
+  >>= fun () ->
+  let block_interval = 1 in
+  let protocol, baker_list =
+    let open Tezos_protocol in
+    let d = default () in
+    let bakers = List.take d.bootstrap_accounts bakers in
+    ( { d with
+        time_between_blocks= [block_interval; 0]
+      ; bootstrap_accounts=
+          List.map d.bootstrap_accounts ~f:(fun (n, v) ->
+              if List.exists bakers ~f:(fun baker -> n = fst baker) then (n, v)
+              else (n, 1_000) ) }
+    , bakers )
+  in
+  let net_size = 3 in
+  let topology = Test_scenario.Topology.(mesh "Simple" net_size) in
+  let all_nodes =
+    Test_scenario.Topology.build ~protocol ~exec:node_exec topology ?base_port
+  in
+  Helpers.dump_connections state all_nodes
+  >>= fun () ->
+  Interactive_test.Pauser.add_commands state
+    Interactive_test.Commands.(
+      all_defaults state ~nodes:all_nodes
+      @ [secret_keys state ~protocol; Log_recorder.Operations.show_all state]) ;
+  Test_scenario.Network.(start_up state ~client_exec (make all_nodes))
+  >>= fun () ->
+  let baker nth_node =
+    let nth_baker = nth_node mod List.length baker_list in
+    let key_name = sprintf "b%d" nth_baker in
+    let node = List.nth_exn all_nodes nth_node in
+    let client = Tezos_client.of_node node ~exec:client_exec in
+    let baker_account = List.nth_exn baker_list nth_baker in
+    let bak =
+      Tezos_client.Keyed.make client ~key_name
+        ~secret_key:(Tezos_protocol.Account.private_key (fst baker_account))
+    in
+    Tezos_client.Keyed.initialize state bak >>= fun _ -> return (client, bak)
+  in
+  baker 0
+  >>= fun (client_0, baker_0) ->
+  baker 1
+  >>= fun (client_1, baker_1) ->
+  baker 2
+  >>= fun (client_2, baker_2) ->
+  Interactive_test.Pauser.add_commands state
+    Interactive_test.Commands.
+      [ arbitrary_command_on_clients state
+          ~clients:[client_0; client_1; client_2] ] ;
+  Asynchronous_result.map_option kiln ~f:(fun k ->
+      Tezos_client.rpc state ~client:client_0 `Get
+        ~path:"/chains/main/chain_id"
+      >>= fun chain_id_json ->
+      let network_id =
+        match chain_id_json with `String s -> s | _ -> assert false
+      in
+      Kiln.start state ~network_id k
+        ~bakers:
+          ( List.map baker_list ~f:(fun (account, _) ->
+                Tezos_protocol.Account.(name account, pubkey_hash account) )
+            @ List.map [baker_0; baker_1; baker_2] ~f:(fun bak ->
+                  ( bak.key_name
+                  , Tezos_protocol.Key.Of_name.pubkey_hash bak.key_name ) )
+          |> List.dedup_and_sort ~compare:(fun (_, a) (_, b) ->
+                 String.compare a b ) )
+        ~node_uris:
+          (List.map all_nodes ~f:(fun {Tezos_node.rpc_port; _} ->
+               sprintf "http://localhost:%d" rpc_port ))
+      >>= fun (pg, kiln) ->
+      Interactive_test.Pauser.generic state EF.[af "Started Kiln with its DB."]
+  )
+  >>= fun (_ : unit option) ->
+  let bake msg baker = Tezos_client.Keyed.bake state baker msg in
+  List.fold
+    (List.init (starting_level - 1) ~f:(fun n -> n))
+    ~init:(return ()) (* We are already at level 1, we bake 7 times: *)
+    ~f:(fun pm n ->
+      pm
+      >>= fun () ->
+      bake
+        (sprintf "first bakes: [%d/%d]" (n + 1) (starting_level - 1))
+        baker_0 )
+  >>= fun () ->
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. all_nodes (`Equal_to starting_level)
+  >>= fun () ->
+  Interactive_test.Pauser.generic state
+    EF.
+      [ af "Clients ready"
+      ; af "Node 0 baked %d times." (starting_level - 1)
+      ; af "All nodes should be at level %d." starting_level ]
+  >>= fun () ->
+  return (all_nodes, client_0, baker_0, client_1, baker_1, client_2, baker_2)
+
+let wait_for_operation_in_mempools state ~nodes:all_nodes ~kind ~client_exec
+    how =
+  let init, combine =
+    match how with `At_least_one -> (false, ( || )) | `All -> (true, ( && ))
+  in
+  Helpers.wait_for state ~attempts:default_attempts ~seconds:8. (fun _ ->
+      List.fold ~init:(return init) all_nodes ~f:(fun prev_m node ->
+          prev_m
+          >>= fun prev ->
+          let client = Tezos_client.of_node node ~exec:client_exec in
+          Tezos_client.mempool_has_operation state ~client ~kind
+          >>= fun client_result -> return (combine client_result prev) )
+      >>= function
+      | true -> return (`Done ())
+      | false ->
+          return
+            (`Not_done
+              (sprintf "Waiting for %S to show up in the mempool" kind)) )
+
+let simple_double_baking ~starting_level ?kiln ~state ~base_port node_exec
+    client_exec () =
+  little_mesh_with_bakers ~bakers:1 state ~node_exec ~client_exec () ~base_port
+    ~starting_level ?kiln
+  >>= fun (all_nodes, client_0, baker_0, client_1, baker_1, client_2, baker_2) ->
+  let kill_nth nth = List.nth_exn all_nodes nth |> Helpers.kill_node state in
+  let restart_nth nth =
+    List.nth_exn all_nodes nth |> Helpers.restart_node ~client_exec state
+  in
+  let number_of_lonely_bakes = 1 in
+  kill_nth 1
+  >>= fun () ->
+  kill_nth 2
+  >>= fun () ->
+  Loop.n_times number_of_lonely_bakes (fun _ ->
+      Tezos_client.Keyed.bake state baker_0 "Bake-on-0" )
+  >>= fun () ->
+  Tezos_client.get_block_header state ~client:client_0 `Head
+  >>= fun baking_0_header ->
+  (* This baking will have better fitness so other nodes will have to fetch it. *)
+  Tezos_client.Keyed.endorse state baker_0 "endorsing lonely bake-on-0"
+  >>= fun () ->
+  System.sleep 1.
+  >>= fun () ->
+  kill_nth 0
+  >>= fun () ->
+  restart_nth 1
+  >>= fun () ->
+  restart_nth 2
+  >>= fun () ->
+  Loop.n_times number_of_lonely_bakes (fun _ ->
+      Tezos_client.Keyed.bake state baker_1 "Bake-on-1" )
+  >>= fun () ->
+  Tezos_client.get_block_header state ~client:client_1 `Head
+  >>= fun baking_1_header ->
+  restart_nth 0
+  >>= fun () ->
+  Tezos_client.Keyed.bake state baker_0 "Bake-on-0"
+  >>= fun () ->
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. all_nodes
+    (`At_least (starting_level + number_of_lonely_bakes + 1))
+  >>= fun () ->
+  Tezos_client.rpc state ~client:client_1 `Get
+    ~path:"/chains/main/blocks/head/hash"
+  >>= fun head_hash_json ->
+  Interactive_test.Pauser.generic state
+    EF.
+      [ af "About to forge"
+      ; ef_json "Baking 0" baking_0_header
+      ; ef_json "Baking 1" baking_1_header
+      ; ef_json "Head hash" head_hash_json ]
+  >>= fun () ->
+  Tezos_client.Keyed.forge_and_inject state baker_1
+    ~json:
+      (let clean header =
+         let open Jqo in
+         remove_field header ~name:"hash"
+         |> remove_field ~name:"chain_id"
+         |> remove_field ~name:"protocol"
+       in
+       `O
+         [ ("branch", head_hash_json)
+         ; ( "contents"
+           , `A
+               [ `O
+                   [ ("kind", `String "double_baking_evidence")
+                   ; ("bh1", clean baking_0_header)
+                   ; ("bh2", clean baking_1_header) ] ] ) ])
+  >>= fun result ->
+  Interactive_test.Pauser.generic state
+    EF.
+      [ af "Waiting for accuser to notice double baking"
+      ; ef_json "Result of injection" result
+      ; af "All nodes reaching level %d"
+          (starting_level + number_of_lonely_bakes + 1) ]
+  >>= fun () ->
+  wait_for_operation_in_mempools state ~nodes:all_nodes
+    ~kind:"double_baking_evidence" ~client_exec `All
+  >>= fun () ->
+  Tezos_client.Keyed.bake state baker_2
+    (sprintf "all at lvl %d" (starting_level + number_of_lonely_bakes + 1))
+  >>= fun () ->
+  let last_level = starting_level + number_of_lonely_bakes + 2 in
+  Interactive_test.Pauser.generic state
+    EF.[af "Just baked what's the level? Vs %d" last_level]
+  >>= fun () ->
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. all_nodes (`Equal_to last_level)
+  >>= fun () ->
+  Helpers.wait_for state ~attempts:10 ~seconds:4. (fun _ ->
+      Tezos_client.block_has_operation state ~client:client_2 ~level:last_level
+        ~kind:"double_baking_evidence"
+      >>= function
+      | true -> return (`Done ())
+      | false ->
+          return
+            (`Not_done
+              (sprintf "Waiting for accusation to show up in block %d"
+                 last_level)) )
+  >>= fun () -> say state EF.(af "Test done.")
+
+let find_endorsement_in_mempool state ~client =
+  Helpers.wait_for state ~attempts:4 ~seconds:2. (fun _ ->
+      Tezos_client.find_applied_in_mempool state ~client ~f:(fun o ->
+          Jqo.field o ~k:"contents"
+          |> Jqo.list_exists ~f:(fun op ->
+                 (* Dbg.e EF.(ef_json "op" op) ; *)
+                 Jqo.field op ~k:"kind" = `String "endorsement" ) )
+      >>= function
+      | None -> return (`Not_done (sprintf "No endorsement so far"))
+      | Some e -> return (`Done e) )
+
+let simple_double_endorsement ~starting_level ?kiln ~state ~base_port node_exec
+    client_exec () =
+  little_mesh_with_bakers ~bakers:2 state ~node_exec ~client_exec ()
+    ~starting_level ~base_port ?kiln
+  >>= fun (all_nodes, client_0, baker_0, client_1, baker_1, client_2, baker_2) ->
+  (* 2 bakers ⇒ baker_0 and baker_2 are for the same key on ≠ nodes *)
+  assert (
+    Tezos_client.Keyed.(
+      baker_0.key_name = baker_2.key_name
+      && baker_0.secret_key = baker_2.secret_key) ) ;
+  let node_0 = List.nth_exn all_nodes 0 in
+  let node_1 = List.nth_exn all_nodes 1 in
+  let node_2 = List.nth_exn all_nodes 2 in
+  let baker_1_n0 =
+    let open Tezos_client.Keyed in
+    let {key_name; secret_key; _} = baker_1 in
+    make client_0 ~key_name ~secret_key
+  in
+  Tezos_client.Keyed.initialize state baker_1_n0
+  >>= fun _ ->
+  Helpers.kill_node state node_1
+  >>= fun () ->
+  Helpers.kill_node state node_2
+  >>= fun () ->
+  Tezos_client.Keyed.bake state baker_0 "baker-0 baking with node 0"
+  >>= fun () ->
+  Tezos_client.Keyed.endorse state baker_0 "baker-0 endorsing with node 0"
+  >>= fun () ->
+  Tezos_client.Keyed.endorse state baker_1_n0 "baker-1 endorsing with node 0"
+  >>= fun () ->
+  find_endorsement_in_mempool state ~client:client_0
+  >>= fun endorsement_0 ->
+  Helpers.kill_node state node_0
+  >>= fun () ->
+  Helpers.restart_node state node_2 ~client_exec
+  >>= fun () ->
+  Tezos_client.Keyed.bake state baker_2 "baker-0 baking with node 2"
+  >>= fun () ->
+  Tezos_client.Keyed.endorse state baker_2 "baker-0 endorsing with node 2"
+  >>= fun () ->
+  find_endorsement_in_mempool state ~client:client_2
+  >>= fun endorsement_1 ->
+  say state
+    EF.(
+      list
+        [ ef_json "Endorsement 0:" endorsement_0
+        ; ef_json "Endorsement 1:" endorsement_1 ])
+  >>= fun () ->
+  Helpers.restart_node state node_1 ~client_exec
+  >>= fun () ->
+  (* Tezos_client.Keyed.bake state baker_0 "baker-0 baking lonelily"
+   * >>= fun () -> *)
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. [node_1; node_2]
+    (`Equal_to (starting_level + 1))
+  >>= fun () ->
+  Helpers.restart_node state node_0 ~client_exec
+  >>= fun () ->
+  (* TODO: understand why this kick in the butt is necessary for node
+     2 (seems like the node was not getting to level starting+2 without
+     this). *)
+  Helpers.kill_node state node_2
+  >>= fun () ->
+  Helpers.restart_node state node_2 ~client_exec
+  >>= fun () ->
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. all_nodes
+    (`Equal_to (starting_level + 1))
+  >>= fun () ->
+  Tezos_client.rpc state ~client:client_1 `Get
+    ~path:"/chains/main/blocks/head/hash"
+  >>= fun head_hash_json ->
+  let double_endorsement =
+    let transform_endorsement endorsement =
+      let branch = Jqo.field ~k:"branch" endorsement in
+      let signature = Jqo.field ~k:"signature" endorsement in
+      let contents =
+        match Jqo.field ~k:"contents" endorsement with
+        | `A [one] -> one
+        | _ -> assert false
+      in
+      `O
+        [("branch", branch); ("operations", contents); ("signature", signature)]
+    in
+    let inlined_endorsement_1 = transform_endorsement endorsement_0 in
+    let inlined_endorsement_2 = transform_endorsement endorsement_1 in
+    `O
+      [ ("branch", head_hash_json)
+      ; ( "contents"
+        , `A
+            [ `O
+                [ ("kind", `String "double_endorsement_evidence")
+                ; ("op1", inlined_endorsement_1)
+                ; ("op2", inlined_endorsement_2) ] ] ) ]
+  in
+  Interactive_test.Pauser.generic state
+    EF.[ef_json "About to forge" double_endorsement]
+  >>= fun () ->
+  Tezos_client.Keyed.forge_and_inject state baker_1 ~json:double_endorsement
+  >>= fun result ->
+  Interactive_test.Pauser.generic state
+    EF.[ef_json "Result of injection" result]
+  >>= fun () ->
+  wait_for_operation_in_mempools state ~nodes:[node_1]
+    ~kind:"double_endorsement_evidence" ~client_exec `All
+  >>= fun () ->
+  let last_level = starting_level + 2 in
+  Tezos_client.Keyed.bake state baker_1 (sprintf "level %d" last_level)
+  >>= fun () ->
+  Tezos_client.Keyed.endorse state baker_1
+    (sprintf "endorse level %d" last_level)
+  >>= fun () ->
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. all_nodes (`Equal_to last_level)
+  >>= fun () ->
+  Helpers.wait_for state ~attempts:10 ~seconds:4. (fun _ ->
+      (* We check that client-2 sees the evidence from baker-1 *)
+      Tezos_client.block_has_operation state ~client:client_2 ~level:last_level
+        ~kind:"double_endorsement_evidence"
+      >>= function
+      | true -> return (`Done ())
+      | false ->
+          return
+            (`Not_done
+              (sprintf "Waiting for accusation to show up in block %d"
+                 last_level)) )
+  >>= fun () -> say state EF.(af "Test done.")
+
+let with_accusers ?kiln ~state ~base_port node_exec accuser_exec client_exec ()
+    =
+  Helpers.clear_root state
+  >>= fun () ->
+  let block_interval = 2 in
+  let protocol, baker_0_account =
+    let open Tezos_protocol in
+    let d = default () in
+    let baker = List.hd_exn d.bootstrap_accounts in
+    ( { d with
+        time_between_blocks= [block_interval; block_interval * 2]
+      ; bootstrap_accounts=
+          List.map d.bootstrap_accounts ~f:(fun (n, v) ->
+              if n = fst baker then (n, v) else (n, 1_000) ) }
+    , baker )
+  in
+  let topology =
+    Test_scenario.Topology.(
+      net_in_the_middle "AT-" (mesh "Mid" 3) (mesh "Main" 4) (mesh "Acc" 4))
+  in
+  let mesh_nodes, intermediary_nodes, accuser_nodes =
+    Test_scenario.Topology.build ~protocol ~exec:node_exec topology ~base_port
+  in
+  let all_nodes = mesh_nodes @ intermediary_nodes @ accuser_nodes in
+  Helpers.dump_connections state all_nodes
+  >>= fun () ->
+  Test_scenario.Network.(start_up state ~client_exec (make all_nodes))
+  >>= fun () ->
+  let start_accuser nod =
+    let client = Tezos_client.of_node nod ~exec:client_exec in
+    let acc = Tezos_daemon.accuser_of_node ~exec:accuser_exec ~client nod in
+    Running_processes.start state (Tezos_daemon.process acc ~state)
+    >>= fun _ -> return ()
+  in
+  List_sequential.iter accuser_nodes ~f:start_accuser
+  >>= fun () ->
+  let key_name = "b0" in
+  let baker nth =
+    let node = List.nth_exn all_nodes nth in
+    let client = Tezos_client.of_node node ~exec:client_exec in
+    let bak =
+      Tezos_client.Keyed.make client ~key_name
+        ~secret_key:(Tezos_protocol.Account.private_key (fst baker_0_account))
+      (* ~secret_key:
+         *   (Tezos_protocol.Key.Of_name.private_key
+         *      (fst baker_0 |> Tezos_protocol.name_to_string)) *)
+    in
+    Tezos_client.Keyed.initialize state bak >>= fun _ -> return (client, bak)
+  in
+  baker 0
+  >>= fun (client_0, baker_0) ->
+  baker 1
+  >>= fun (client_1, baker_1) ->
+  baker 2
+  >>= fun (client_2, baker_2) ->
+  Asynchronous_result.map_option kiln ~f:(fun k ->
+      Tezos_client.rpc state ~client:client_0 `Get
+        ~path:"/chains/main/chain_id"
+      >>= fun chain_id_json ->
+      let network_id =
+        match chain_id_json with `String s -> s | _ -> assert false
+      in
+      Kiln.start state ~network_id k
+        ~bakers:
+          [ Tezos_protocol.Account.(
+              let acc = fst baker_0_account in
+              (name acc, pubkey_hash acc)) ]
+        ~node_uris:
+          (List.map all_nodes ~f:(fun {Tezos_node.rpc_port; _} ->
+               sprintf "http://localhost:%d" rpc_port ))
+      >>= fun (pg, kiln) ->
+      Interactive_test.Pauser.generic state EF.[af "Started Kiln with its DB."]
+  )
+  >>= fun (_ : unit option) ->
+  Interactive_test.Pauser.add_commands state
+    Interactive_test.Commands.(
+      all_defaults state ~nodes:all_nodes
+      @ [ secret_keys state ~protocol
+        ; Log_recorder.Operations.show_all state
+        ; arbitrary_command_on_clients state
+            ~clients:[client_0; client_1; client_2] ]) ;
+  let pause ?force msgs = Interactive_test.Pauser.generic state ?force msgs in
+  let starting_level = 10 in
+  List.fold
+    (List.init (starting_level - 1) ~f:(fun n -> n))
+    ~init:(return ()) (* We are already at level 1, we bake 7 times: *)
+    ~f:(fun pm n ->
+      pm
+      >>= fun () ->
+      Tezos_client.Keyed.bake state baker_0
+        (sprintf "first bakes: [%d/%d]" (n + 1) (starting_level - 1)) )
+  >>= fun () ->
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. all_nodes (`Equal_to starting_level)
+  >>= fun () ->
+  pause
+    EF.
+      [ af "Two clients ready"
+      ; af "Node 0 baked %d times." (starting_level - 1)
+      ; af "All nodes should be at level %d." starting_level ]
+  >>= fun () ->
+  let transfer msg client =
+    let dest =
+      List.random_element_exn protocol.Tezos_protocol.bootstrap_accounts
+      |> fst |> Tezos_protocol.Account.pubkey_hash
+    in
+    Tezos_client.successful_client_cmd state ~client
+      [ "--wait"; "none"; "transfer"; "1"; "from"; key_name; "to"; dest; "--fee"
+      ; "0.05" ]
+    >>= fun res ->
+    say state
+      EF.(
+        desc
+          (af "Successful transfer (%s):" client.Tezos_client.id)
+          (ocaml_string_list res#out))
+  in
+  List_sequential.iter intermediary_nodes ~f:(fun x ->
+      Helpers.kill_node state x )
+  >>= fun () ->
+  let kill_all_but nodes iths =
+    List_sequential.iteri nodes ~f:(fun ith n ->
+        if List.mem iths ith ~equal:Int.equal then return ()
+        else Helpers.kill_node state n )
+  in
+  let kill_nth_node nodes nth =
+    Helpers.kill_node state
+      (Option.value_exn ~message:"kill_nth_node" (List.nth nodes nth))
+  in
+  let restart_nth_node nodes nth =
+    Helpers.restart_node state ~client_exec
+      (Option.value_exn ~message:"restart_nth_node" (List.nth nodes nth))
+  in
+  let get_block_header ~client block =
+    let path =
+      sprintf "/chains/main/blocks/%s/header"
+        (match block with `Head -> "head" | `Level i -> Int.to_string i)
+    in
+    Tezos_client.rpc state ~client `Get ~path
+  in
+  kill_all_but mesh_nodes [0]
+  >>= fun () ->
+  let number_of_lonely_bakes = 1 in
+  pause EF.[af "Node 0 is the only one alive"]
+  >>= fun () ->
+  transfer "node0 only alive" client_0
+  >>= fun () ->
+  Loop.n_times number_of_lonely_bakes (fun n ->
+      Tezos_client.Keyed.bake state baker_0 (sprintf "n0 only alive: %d" n) )
+  >>= fun () ->
+  get_block_header ~client:client_0 `Head
+  >>= fun baking_0_header ->
+  Tezos_client.Keyed.endorse state baker_0 "self-endorsing"
+  >>= fun () ->
+  Tezos_client.Keyed.bake state baker_0 "baking self-endorsement"
+  >>= fun () ->
+  kill_nth_node mesh_nodes 0
+  >>= fun () ->
+  restart_nth_node mesh_nodes 1
+  >>= fun () ->
+  transfer "node1 only one alive" client_1
+  >>= fun () ->
+  Loop.n_times number_of_lonely_bakes (fun _ ->
+      Tezos_client.Keyed.bake state baker_1 "after transfer" )
+  >>= fun () ->
+  get_block_header ~client:client_1 `Head
+  >>= fun baking_1_header ->
+  kill_nth_node mesh_nodes 1
+  >>= fun () ->
+  pause
+    EF.
+      [ af "Node 0 was killed"; af "Node 1 was restarted"
+      ; af "Node 1 transfered"; af "Node 1 baked"; af "Node 1 was killed" ]
+  >>= fun () ->
+  List.fold ~init:(return ()) intermediary_nodes ~f:(fun prev x ->
+      prev >>= fun () -> Helpers.restart_node state ~client_exec x )
+  >>= fun () ->
+  let node_0 = List.nth_exn mesh_nodes 0 in
+  let except_0 l = List.filter l ~f:Tezos_node.(fun n -> n.id <> node_0.id) in
+  List_sequential.iter (except_0 mesh_nodes)
+    ~f:(Helpers.restart_node state ~client_exec)
+  >>= fun () ->
+  pause EF.[af "All nodes restarted Except 0"]
+  >>= fun () ->
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. (except_0 all_nodes)
+    (`At_least (starting_level + number_of_lonely_bakes))
+  >>= fun () ->
+  Helpers.restart_node state ~client_exec node_0
+  >>= fun () ->
+  pause EF.[af "Restarted 0"]
+  >>= fun () ->
+  Helpers.wait_for state ~attempts:default_attempts ~seconds:8. (fun _ ->
+      List.fold ~init:(return false) accuser_nodes ~f:(fun prev_m node ->
+          prev_m
+          >>= fun prev ->
+          let client = Tezos_client.of_node node ~exec:client_exec in
+          Tezos_client.mempool_has_operation state ~client
+            ~kind:"double_baking_evidence"
+          >>= fun client_result -> return (client_result || prev) )
+      >>= function
+      | true -> return (`Done ())
+      | false ->
+          return
+            (`Not_done
+              (sprintf "Waiting for accusation to show up in the mempool")) )
+  >>= fun () ->
+  Tezos_client.Keyed.bake state baker_2
+    (sprintf "all at lvl %d" (starting_level + number_of_lonely_bakes + 1))
+  >>= fun () ->
+  Helpers.wait_for state ~attempts:10 ~seconds:4. (fun _ ->
+      let level = starting_level + number_of_lonely_bakes + 2 in
+      Tezos_client.block_has_operation state ~client:client_2 ~level
+        ~kind:"double_baking_evidence"
+      >>= function
+      | true -> return (`Done ())
+      | false ->
+          return
+            (`Not_done
+              (sprintf "Waiting for accusation to show up in block %d" level))
+  )
+  >>= fun () ->
+  pause
+    EF.
+      [ af "One more baking (level should include accusation)"
+      ; af "All nodes reaching level %d"
+          (starting_level + number_of_lonely_bakes + 2) ]
+  >>= fun () ->
+  Tezos_client.Keyed.bake state baker_1 "a couple more"
+  >>= fun () ->
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. all_nodes
+    (`At_least (starting_level + number_of_lonely_bakes + 1))
+
+let cmd ~pp_error () =
+  let open Cmdliner in
+  let open Term in
+  let pf fmt = ksprintf (fun s -> `P s) fmt in
+  let tests =
+    let test variant name title man = (variant, name, title, man) in
+    [ test `With_accusers "with-accusers" "Network With Accusers"
+        (pf
+           "This test builds a network with 3 interconnected meshes: Main, \
+            Intermediate, and Accuser.")
+    ; test `Simple_double_baking "simple-double-baking"
+        "Simple Network With Manual Double Baking Accusation"
+        (pf
+           "This test builds a very simple 3-piece network, makes a baker \
+            double bake and $(i,manually) inserts a double-baking accusation.")
+    ; test `Simple_double_endorsing "simple-double-endorsing"
+        "Simple Network With Manual Double Endorsing Accusation"
+        (pf
+           "This test builds a very simple 3-piece network, makes a baker \
+            double endorse and $(i,manually) inserts a double-baking \
+            accusation.") ]
+  in
+  Test_command_line.Run_command.make ~pp_error
+    ( pure
+        (fun test
+        base_port
+        (`Starting_level starting_level)
+        bnod
+        bcli
+        accex
+        kiln
+        state
+        ->
+          let actual_test =
+            match test with
+            | `With_accusers -> with_accusers ~state bnod accex bcli ~base_port
+            | `Simple_double_baking ->
+                simple_double_baking ~state bnod bcli ~base_port ?kiln
+                  ~starting_level
+            | `Simple_double_endorsing ->
+                simple_double_endorsement ~state bnod bcli ~base_port ?kiln
+                  ~starting_level
+          in
+          (state, Interactive_test.Pauser.run_test ~pp_error state actual_test)
+      )
+    $ Arg.(
+        required
+          (pos 0
+             (some (enum (List.map tests ~f:(fun (v, n, _, _) -> (n, v)))))
+             None
+             (info [] ~docv:"TEST-NAME" ~doc:"Choose which test to run.")))
+    $ Arg.(
+        value & opt int 30_000
+        & info ["base-port"] ~doc:"Base port number to build upon.")
+    $ Arg.(
+        pure (fun l -> `Starting_level l)
+        $ value
+            (opt int 5
+               (info ["starting-level"]
+                  ~doc:
+                    "Initial block-level to reach before actually starting \
+                     the test.")))
+    $ Tezos_executable.cli_term `Node "tezos"
+    $ Tezos_executable.cli_term `Client "tezos"
+    $ Tezos_executable.cli_term `Accuser "tezos"
+    $ Kiln.cli_term ()
+    $ Test_command_line.cli_state ~name:"accusing" () )
+    (let doc = "Sandbox networks which record double-bakings." in
+     let man : Manpage.block list =
+       [ `S "ACCUSATION TESTS"
+       ; pf
+           "This command provides %d tests which use network sandboxes to \
+            make double-bakings and double-endorsements happen."
+           (List.length tests)
+       ; `Blocks
+           (List.map tests ~f:(fun (_, n, tit, m) ->
+                `Blocks [pf "* $(b,`%s`): $(i,%s)." n tit; `Noblank; m] )) ]
+     in
+     info ~man ~doc "accusations")
diff --git a/src/bin_flextesa/command_mini_network.ml b/src/bin_flextesa/command_mini_network.ml
new file mode 100644
index 000000000000..8a8486a690fa
--- /dev/null
+++ b/src/bin_flextesa/command_mini_network.ml
@@ -0,0 +1,120 @@
+open Tezos_network_sandbox
+open Internal_pervasives
+open Console
+
+let run state ~protocol ~size ~base_port ?kiln node_exec client_exec baker_exec
+    endorser_exec accuser_exec () =
+  Test_scenario.network_with_protocol ~protocol ~size ~base_port state
+    ~node_exec ~client_exec
+  >>= fun (nodes, protocol) ->
+  Tezos_client.rpc state
+    ~client:(Tezos_client.of_node (List.hd_exn nodes) ~exec:client_exec)
+    `Get ~path:"/chains/main/chain_id"
+  >>= fun chain_id_json ->
+  let network_id =
+    match chain_id_json with `String s -> s | _ -> assert false
+  in
+  Asynchronous_result.map_option kiln ~f:(fun k ->
+      Kiln.start state ~network_id k
+        ~bakers:
+          (List.map protocol.Tezos_protocol.bootstrap_accounts
+             ~f:(fun (account, _) ->
+               Tezos_protocol.Account.(name account, pubkey_hash account) ))
+        ~node_uris:
+          (List.map nodes ~f:(fun {Tezos_node.rpc_port; _} ->
+               sprintf "http://localhost:%d" rpc_port ))
+      >>= fun (pg, kiln) -> return () )
+  >>= fun (_ : unit option) ->
+  let accusers =
+    List.map nodes ~f:(fun node ->
+        let client = Tezos_client.of_node node ~exec:client_exec in
+        Tezos_daemon.accuser_of_node ~exec:accuser_exec ~client node )
+  in
+  List_sequential.iter accusers ~f:(fun acc ->
+      Running_processes.start state (Tezos_daemon.process acc ~state)
+      >>= fun {process; lwt} -> return () )
+  >>= fun () ->
+  let keys_and_daemons =
+    let pick_a_node_and_client idx =
+      match List.nth nodes ((1 + idx) mod List.length nodes) with
+      | Some node -> (node, Tezos_client.of_node node ~exec:client_exec)
+      | None -> assert false
+    in
+    Tezos_protocol.bootstrap_accounts protocol
+    |> List.mapi ~f:(fun idx acc ->
+           let node, client = pick_a_node_and_client idx in
+           let key = Tezos_protocol.Account.name acc in
+           ( acc
+           , client
+           , [ Tezos_daemon.baker_of_node ~exec:baker_exec ~client node ~key
+             ; Tezos_daemon.endorser_of_node ~exec:endorser_exec ~client node
+                 ~key ] ) )
+  in
+  List_sequential.iter keys_and_daemons ~f:(fun (acc, client, daemons) ->
+      Tezos_client.bootstrapped ~state client
+      >>= fun () ->
+      let key, priv = Tezos_protocol.Account.(name acc, private_key acc) in
+      Tezos_client.import_secret_key ~state client key priv
+      >>= fun () ->
+      say state
+        EF.(
+          desc_list
+            (haf "Registration-as-delegate:")
+            [ desc (af "Client:") (af "%S" client.Tezos_client.id)
+            ; desc (af "Key:") (af "%S" key) ])
+      >>= fun () ->
+      Tezos_client.register_as_delegate ~state client key
+      >>= fun () ->
+      say state
+        EF.(
+          desc_list (haf "Starting daemons:")
+            [ desc (af "Client:") (af "%S" client.Tezos_client.id)
+            ; desc (af "Key:") (af "%S" key) ])
+      >>= fun () ->
+      List_sequential.iter daemons ~f:(fun daemon ->
+          Running_processes.start state (Tezos_daemon.process daemon ~state)
+          >>= fun {process; lwt} -> return () ) )
+  >>= fun () ->
+  Prompt.(
+    command state
+      ~commands:
+        Interactive_test.Commands.(
+          all_defaults state ~nodes
+          @ [ secret_keys state ~protocol
+            ; arbitrary_command_on_clients state
+                ~clients:
+                  (List.map nodes ~f:(Tezos_client.of_node ~exec:client_exec))
+            ]))
+
+let cmd ~pp_error () =
+  let open Cmdliner in
+  let open Term in
+  Test_command_line.Run_command.make ~pp_error
+    ( pure (fun size base_port protocol bnod bcli bak endo accu kiln state ->
+          let actual_test =
+            run state ~size ~base_port ~protocol bnod bcli bak endo accu ?kiln
+          in
+          (state, Interactive_test.Pauser.run_test ~pp_error state actual_test)
+      )
+    $ Arg.(
+        value & opt int 5
+        & info ["size"; "S"] ~doc:"Set the size of the network.")
+    $ Arg.(
+        value & opt int 20_000
+        & info ["base-port"; "P"] ~doc:"Base port number to build upon.")
+    $ Tezos_protocol.cli_term ()
+    $ Tezos_executable.cli_term `Node "tezos"
+    $ Tezos_executable.cli_term `Client "tezos"
+    $ Tezos_executable.cli_term `Baker "tezos"
+    $ Tezos_executable.cli_term `Endorser "tezos"
+    $ Tezos_executable.cli_term `Accuser "tezos"
+    $ Kiln.cli_term ()
+    $ Test_command_line.cli_state ~name:"mininet" () )
+    (let doc = "Small network sandbox with bakers, endorsers, and accusers." in
+     let man : Manpage.block list =
+       [ `P
+           "This test builds a small sandbox network, start various daemons, \
+            and then gives the user an interactive command prompt to inspect \
+            the network." ]
+     in
+     info "mini-network" ~man ~doc)
diff --git a/src/bin_flextesa/command_prevalidation.ml b/src/bin_flextesa/command_prevalidation.ml
new file mode 100644
index 000000000000..aaea1113647e
--- /dev/null
+++ b/src/bin_flextesa/command_prevalidation.ml
@@ -0,0 +1,36 @@
+open Tezos_network_sandbox
+open Internal_pervasives
+open Console
+
+let run state node_exec client_exec () =
+  Test_scenario.network_with_protocol ~size:2 state ~node_exec ~client_exec
+  >>= fun (nodes, protocol) ->
+  match nodes with
+  | [] | [_] | _ :: _ :: _ :: _ -> assert false
+  | [n1; n2] ->
+      let c1 = Tezos_client.of_node ~exec:client_exec n1 in
+      let c2 = Tezos_client.of_node ~exec:client_exec n2 in
+      (* TODO: helpers for
+         - injecting an op
+         - displaying the mempool
+         - setting filter plugin config
+
+         TODO: non-interactive test for propagation
+         TODO: commands for interactivea use *)
+      Pervasives.ignore c1 ;
+      Pervasives.ignore c2 ;
+      return ()
+      >>= fun () ->
+      let commands = Interactive_test.Commands.all_defaults state ~nodes in
+      Prompt.command state ~commands
+      >>= fun () -> Running_processes.wait_all state
+
+let cmd ~pp_error () =
+  let open Cmdliner in
+  let open Term in
+  Test_command_line.Run_command.make ~pp_error
+    ( pure (fun bnod bcli state -> (state, run state bnod bcli))
+    $ Tezos_executable.cli_term `Node "tezos"
+    $ Tezos_executable.cli_term `Client "tezos"
+    $ Test_command_line.cli_state ~name:"prevalidation" () )
+    (info ~doc:"Work-in-progress." "prevalidation")
diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml
new file mode 100644
index 000000000000..a60957c85745
--- /dev/null
+++ b/src/bin_flextesa/command_voting.ml
@@ -0,0 +1,516 @@
+(* Semi-interactive test for voting *)
+open Tezos_network_sandbox
+open Internal_pervasives
+module Counter_log = Helpers.Counter_log
+
+let ledger_prompt_notice state ef =
+  Console.say state
+    EF.(
+      desc (shout "Ledger-prompt")
+        (list [ef; wf "Please hit “✔” on the ledger."]))
+
+let setup_baking_ledger state uri ~client =
+  Interactive_test.Pauser.generic state
+    EF.
+      [ wf "Setting up the ledger device %S" uri
+      ; haf
+          "Please make sure the ledger is on the Baking app and quit (`q`) \
+           this prompt to continue." ]
+    ~force:true
+  >>= fun () ->
+  let key_name = "ledgered" in
+  let baker = Tezos_client.Keyed.make client ~key_name ~secret_key:uri in
+  ledger_prompt_notice state
+    EF.(
+      wf
+        "Importing %S in client `%s`. The ledger should be prompting for \
+         acknowledgment to provide the public key."
+        uri client.Tezos_client.id)
+  >>= fun () ->
+  Tezos_client.Keyed.initialize state baker
+  >>= fun _ ->
+  ledger_prompt_notice state
+    EF.(
+      wf
+        "Setting up %S for baking. The ledger should be showing the setup \
+         parameters (Address, Main chain, HWMs)."
+        uri)
+  >>= fun () ->
+  Tezos_client.successful_client_cmd state ~client
+    [ "setup"; "ledger"; "to"; "bake"; "for"; key_name; "--main-hwm"; "0"
+    ; "--test-hwm"; "0" ]
+  >>= fun _ -> return baker
+
+let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt
+
+type voting_period =
+                    Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period
+                    .kind =
+  | Proposal
+  | Testing_vote
+  | Testing
+  | Promotion_vote
+
+let voting_period_to_string (p : voting_period) =
+  match
+    Tezos_data_encoding.Data_encoding.Json.construct
+      Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind_encoding
+      p
+  with
+  | `String s -> s
+  | other -> assert false
+
+let transfer state ~client ~src ~dst ~amount =
+  Tezos_client.successful_client_cmd state ~client
+    [ "--wait"; "none"; "transfer"; sprintf "%d" amount; "from"; src; "to"; dst
+    ; "--fee"; "0.05"; "--burn-cap"; "0.3" ]
+
+let bake_until_voting_period ?keep_alive_delegate state ~baker ~attempts period
+    =
+  let client = baker.Tezos_client.Keyed.client in
+  let period_name = voting_period_to_string period in
+  Helpers.wait_for state ~attempts ~seconds:0.5 (fun nth ->
+      Tezos_client.rpc state ~client `Get
+        ~path:"/chains/main/blocks/head/votes/current_period_kind"
+      >>= function
+      | `String p when p = period_name -> return (`Done (nth - 1))
+      | other ->
+          Asynchronous_result.map_option keep_alive_delegate ~f:(fun dst ->
+              transfer state ~client ~amount:1
+                ~src:baker.Tezos_client.Keyed.key_name ~dst
+              >>= fun res -> return () )
+          >>= fun _ ->
+          ksprintf
+            (Tezos_client.Keyed.bake state baker)
+            "Baker %s bakes %d/%d waiting for %S voting period" client.id nth
+            attempts period_name
+          >>= fun () ->
+          return (`Not_done (sprintf "Waiting for %S period" period_name)) )
+
+let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port
+    ~serialize_proposals ?with_ledger () =
+  let default_attempts = 35 in
+  Helpers.clear_root state
+  >>= fun () ->
+  Interactive_test.Pauser.generic state
+    EF.[af "Ready to start"; af "Root path deleted."]
+  >>= fun () ->
+  let protocol, baker_0_account, baker_0_balance =
+    let open Tezos_protocol in
+    let d = default () in
+    let baker = List.nth_exn d.bootstrap_accounts 0 in
+    ( { d with
+        time_between_blocks= [1; 0]
+      ; bootstrap_accounts=
+          List.map d.bootstrap_accounts ~f:(fun (n, v) ->
+              if fst baker = n then (n, v) else (n, 1_000) ) }
+    , fst baker
+    , snd baker )
+  in
+  Test_scenario.network_with_protocol ~protocol ~size ~base_port state
+    ~node_exec ~client_exec
+  >>= fun (nodes, protocol) ->
+  let make_admin = Tezos_admin_client.of_client ~exec:admin_exec in
+  Interactive_test.Pauser.add_commands state
+    Interactive_test.Commands.(
+      all_defaults state ~nodes
+      @ [ secret_keys state ~protocol
+        ; Log_recorder.Operations.show_all state
+        ; arbitrary_command_on_clients state ~command_names:["all-clients"]
+            ~make_admin
+            ~clients:
+              (List.map nodes ~f:(Tezos_client.of_node ~exec:client_exec)) ]) ;
+  Interactive_test.Pauser.generic state EF.[af "About to really start playing"]
+  >>= fun () ->
+  let client n =
+    Tezos_client.of_node ~exec:client_exec (List.nth_exn nodes n)
+  in
+  let baker_0 =
+    Tezos_client.Keyed.make (client 0) ~key_name:"baker-0"
+      ~secret_key:(Tezos_protocol.Account.private_key baker_0_account)
+  in
+  Tezos_client.Keyed.initialize state baker_0
+  >>= fun _ ->
+  let level_counter = Counter_log.create () in
+  let first_bakes = 5 in
+  Loop.n_times first_bakes (fun nth ->
+      ksprintf (Tezos_client.Keyed.bake state baker_0) "initial-bake %d" nth )
+  >>= fun () ->
+  let initial_level = first_bakes + 1 in
+  Counter_log.add level_counter "initial_level" initial_level ;
+  ( match with_ledger with
+  | None ->
+      Console.say state EF.(wf "No ledger.")
+      >>= fun () ->
+      let account = Tezos_protocol.Account.of_name "special-baker" in
+      let baker =
+        Tezos_client.Keyed.make (client 0)
+          ~key_name:(Tezos_protocol.Account.name account)
+          ~secret_key:(Tezos_protocol.Account.private_key account)
+      in
+      Tezos_client.Keyed.initialize state baker >>= fun _ -> return baker
+  | Some uri -> setup_baking_ledger state ~client:(client 0) uri )
+  >>= fun special_baker ->
+  Interactive_test.Pauser.add_commands state
+    Interactive_test.Commands.
+      [ arbitrary_command_on_clients state ~command_names:["baker"] ~make_admin
+          ~clients:[special_baker.Tezos_client.Keyed.client] ] ;
+  transfer state (* Tezos_client.successful_client_cmd state *)
+    ~client:(client 0)
+    ~amount:(baker_0_balance / 2_000_000)
+    ~src:"baker-0" ~dst:special_baker.Tezos_client.Keyed.key_name
+  >>= fun res ->
+  Console.say state
+    EF.(
+      desc
+        (wf "Successful transfer baker-0 -> special:")
+        (ocaml_string_list res#out))
+  >>= fun () ->
+  let after_transfer_bakes = 2 in
+  Loop.n_times after_transfer_bakes (fun nth ->
+      ksprintf
+        (Tezos_client.Keyed.bake state baker_0)
+        "after-transfer-bake %d" nth )
+  >>= fun () ->
+  Counter_log.add level_counter "after-transfer-bakes" after_transfer_bakes ;
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. nodes
+    (`At_least (Counter_log.sum level_counter))
+  >>= fun () ->
+  Asynchronous_result.map_option with_ledger ~f:(fun _ ->
+      ledger_prompt_notice state EF.(wf "Registering as delegate.") )
+  >>= fun (_ : unit option) ->
+  Tezos_client.successful_client_cmd state ~client:(client 0)
+    [ "--wait"; "none"; "register"; "key"
+    ; special_baker.Tezos_client.Keyed.key_name; "as"; "delegate"; "--fee"
+    ; "0.5" ]
+  >>= fun _ ->
+  let activation_bakes =
+    let open Tezos_protocol in
+    protocol.blocks_per_cycle * (protocol.preserved_cycles + 2)
+  in
+  Loop.n_times activation_bakes (fun nth ->
+      ksprintf
+        (Tezos_client.Keyed.bake state baker_0)
+        "Baking after new delegate registered: %d/%d" nth activation_bakes
+      >>= fun () ->
+      Tezos_client.successful_client_cmd state ~client:(client 0)
+        ["rpc"; "get"; "/chains/main/blocks/head/helpers/baking_rights"]
+      >>= fun res ->
+      Console.say state
+        EF.(
+          desc (haf "Baking rights")
+            (markdown_verbatim (String.concat ~sep:"\n" res#out))) )
+  >>= fun () ->
+  Counter_log.add level_counter "activation-bakes" activation_bakes ;
+  Tezos_client.Keyed.bake state special_baker "Baked by Special Baker™"
+  >>= fun () ->
+  Counter_log.incr level_counter "special-baker-first-bake" ;
+  let attempts =
+    Tezos_protocol.(
+      (* If we are right after the proposal period, we need to get to
+         the next one *)
+      3 * protocol.blocks_per_voting_period)
+  in
+  bake_until_voting_period state ~baker:special_baker ~attempts Proposal
+    ~keep_alive_delegate:baker_0.key_name
+  >>= fun extra_bakes_waiting_for_proposal_period ->
+  Counter_log.add level_counter "wait-for-proposal-period"
+    extra_bakes_waiting_for_proposal_period ;
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. nodes
+    (`At_least (Counter_log.sum level_counter))
+  >>= fun () ->
+  let admin_0 = Tezos_admin_client.of_client ~exec:admin_exec (client 0) in
+  Tezos_admin_client.successful_command admin_0 state ["list"; "protocols"]
+  >>= fun res ->
+  let default_protocols = res#out in
+  let make_and_inject_protocol name =
+    let tmpdir = Paths.root state // sprintf "protocol-%s" name in
+    Console.say state EF.(wf "Injecting protocol from %s" tmpdir)
+    >>= fun () ->
+    Running_processes.run_successful_cmdf state
+      "cp -r %s %s && echo '(* Protocol %s *)' >> %s/main.mli"
+      (Filename.quote demo_path) (Filename.quote tmpdir) name
+      (Filename.quote tmpdir)
+    >>= fun _ ->
+    Tezos_admin_client.successful_command admin_0 state
+      ["inject"; "protocol"; tmpdir]
+    >>= fun res -> return ()
+  in
+  Loop.n_times 3 (fun nth -> make_and_inject_protocol (sprintf "The%dth" nth))
+  >>= fun () ->
+  Tezos_admin_client.successful_command admin_0 state ["list"; "protocols"]
+  >>= fun res ->
+  let after_injections_protocols = res#out in
+  Interactive_test.Pauser.generic state
+    EF.
+      [ af "Network up"
+      ; desc (haf "Protcols")
+        @@ list
+             (List.map after_injections_protocols ~f:(fun p ->
+                  af "`%s` (%s)" p
+                    ( if List.mem default_protocols p ~equal:String.equal then
+                      "previously known"
+                    else "injected" ) )) ]
+  >>= fun () ->
+  let new_protocols =
+    List.filter after_injections_protocols ~f:(fun ph ->
+        not (List.mem default_protocols ph ~equal:String.equal) )
+  in
+  Asynchronous_result.map_option with_ledger ~f:(fun _ ->
+      Interactive_test.Pauser.generic state
+        EF.
+          [ af "About to VOTE"
+          ; haf "Please switch to the Wallet app and quit (`q`) this prompt."
+          ]
+        ~force:true )
+  >>= fun (_ : unit option) ->
+  let submit_proposals baker props =
+    Asynchronous_result.map_option with_ledger ~f:(fun _ ->
+        ledger_prompt_notice state
+          EF.(
+            wf "Submitting proposal%s: %s"
+              (if List.length props = 1 then "" else "s")
+              (String.concat ~sep:", " props)) )
+    >>= fun _ ->
+    Tezos_client.successful_client_cmd state
+      ~client:baker.Tezos_client.Keyed.client
+      (["submit"; "proposals"; "for"; baker.key_name] @ props)
+    >>= fun _ -> return ()
+  in
+  ( match serialize_proposals with
+  | false -> submit_proposals special_baker new_protocols
+  | true ->
+      List_sequential.iter new_protocols ~f:(fun one ->
+          submit_proposals special_baker [one] ) )
+  >>= fun () ->
+  let winner = List.hd_exn new_protocols in
+  Tezos_client.successful_client_cmd state ~client:baker_0.client
+    ["submit"; "proposals"; "for"; baker_0.key_name; winner]
+  >>= fun res ->
+  bake_until_voting_period state ~baker:baker_0
+    ~attempts:protocol.blocks_per_voting_period Testing_vote
+    ~keep_alive_delegate:special_baker.key_name
+  >>= fun extra_bakes_waiting_for_testing_vote_period ->
+  Counter_log.add level_counter "wait-for-testing-vote-period"
+    extra_bakes_waiting_for_testing_vote_period ;
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. nodes
+    (`At_least (Counter_log.sum level_counter))
+  >>= fun () ->
+  Helpers.wait_for state ~attempts:default_attempts ~seconds:2. (fun nth ->
+      Tezos_client.rpc state ~client:(client 1) `Get
+        ~path:"/chains/main/blocks/head/votes/current_proposal"
+      >>= fun current_proposal_json ->
+      if current_proposal_json <> `String winner then
+        return
+          (`Not_done
+            (sprintf "Waiting for current_proposal_json to be %s (%s)" winner
+               Ezjsonm.(to_string (wrap current_proposal_json))))
+      else return (`Done ()) )
+  >>= fun () ->
+  Tezos_client.successful_client_cmd state ~client:baker_0.client
+    ["submit"; "ballot"; "for"; baker_0.key_name; winner; "yay"]
+  >>= fun _ ->
+  Asynchronous_result.map_option with_ledger ~f:(fun _ ->
+      ledger_prompt_notice state
+        EF.(wf "Submitting “Yes” ballot for %S" winner) )
+  >>= fun (_ : unit option) ->
+  Tezos_client.successful_client_cmd state ~client:special_baker.client
+    ["submit"; "ballot"; "for"; special_baker.key_name; winner; "yay"]
+  >>= fun _ ->
+  Interactive_test.Pauser.generic state
+    EF.[af "Ballots are in (not baked though)"]
+  >>= fun () ->
+  bake_until_voting_period state ~baker:baker_0
+    ~attempts:(1 + protocol.blocks_per_voting_period)
+    ~keep_alive_delegate:special_baker.key_name Testing
+  >>= fun extra_bakes_waiting_for_testing_period ->
+  Counter_log.add level_counter "wait-for-testing-period"
+    extra_bakes_waiting_for_testing_period ;
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. nodes
+    (`At_least (Counter_log.sum level_counter))
+  >>= fun () ->
+  Helpers.wait_for state ~attempts:default_attempts ~seconds:0.3 (fun nth ->
+      Tezos_client.rpc state ~client:(client 1) `Get
+        ~path:"/chains/main/blocks/head/metadata"
+      >>= fun metadata_json ->
+      try
+        match
+          Jqo.field metadata_json ~k:"test_chain_status"
+          |> Jqo.field ~k:"protocol"
+        with
+        | `String s when s = winner -> return (`Done ())
+        | other ->
+            return
+              (`Not_done
+                (sprintf "Wrong protocol: %s" Ezjsonm.(to_string (wrap other))))
+      with e ->
+        return
+          (`Not_done
+            (sprintf "Cannot get test-chain protocol: %s → %s"
+               (Exn.to_string e)
+               Ezjsonm.(to_string (wrap metadata_json)))) )
+  >>= fun () ->
+  bake_until_voting_period state ~baker:baker_0
+    ~attempts:(1 + protocol.blocks_per_voting_period)
+    ~keep_alive_delegate:special_baker.key_name Promotion_vote
+  >>= fun extra_bakes_waiting_for_promotion_period ->
+  Counter_log.add level_counter "wait-for-promotion-period"
+    extra_bakes_waiting_for_promotion_period ;
+  Test_scenario.Queries.wait_for_all_levels_to_be state
+    ~attempts:default_attempts ~seconds:8. nodes
+    (`At_least (Counter_log.sum level_counter))
+  >>= fun () ->
+  Interactive_test.Pauser.generic state EF.[haf "Before ballots"]
+  >>= fun () ->
+  Tezos_client.successful_client_cmd state ~client:baker_0.client
+    ["submit"; "ballot"; "for"; baker_0.key_name; winner; "yay"]
+  >>= fun _ ->
+  Asynchronous_result.map_option with_ledger ~f:(fun _ ->
+      ledger_prompt_notice state
+        EF.(wf "Submitting “Yes” ballot for %S" winner) )
+  >>= fun (_ : unit option) ->
+  Tezos_client.successful_client_cmd state ~client:special_baker.client
+    ["submit"; "ballot"; "for"; special_baker.key_name; winner; "yay"]
+  >>= fun _ ->
+  Interactive_test.Pauser.generic state
+    EF.[af "Final ballot(s) are in (not baked though)"]
+  >>= fun () ->
+  let ballot_bakes = 1 in
+  Loop.n_times ballot_bakes (fun _ ->
+      Tezos_client.Keyed.bake state baker_0 "Baking the promotion vote ballots"
+  )
+  >>= fun () ->
+  Counter_log.add level_counter "bake-the-ballots" ballot_bakes ;
+  Tezos_client.successful_client_cmd state ~client:(client 0)
+    ["list"; "understood"; "protocols"]
+  >>= fun client_protocols_result ->
+  Interactive_test.Pauser.generic state
+    EF.
+      [ af "Final ballot(s) are baked in."
+      ; af "The client `%s` understands the following protocols: %s"
+          Tezos_executable.(
+            Option.value
+              ~default:(default_binary client_exec)
+              client_exec.binary)
+          (String.concat ~sep:", " client_protocols_result#out) ]
+  >>= fun () ->
+  Helpers.wait_for state ~seconds:0.5
+    ~attempts:(1 + protocol.blocks_per_voting_period) (fun nth ->
+      let client = baker_0.client in
+      Running_processes.run_successful_cmdf state
+        "curl http://localhost:%d/chains/main/blocks/head/metadata" client.port
+      >>= fun curl_res ->
+      let json_string = curl_res#out |> String.concat ~sep:"\n" in
+      let json_metadata = Ezjsonm.from_string json_string in
+      match Jqo.field json_metadata ~k:"next_protocol" with
+      | `String p when p = winner -> return (`Done (nth - 1))
+      | other ->
+          transfer state ~client ~amount:1
+            ~src:baker_0.Tezos_client.Keyed.key_name
+            ~dst:special_baker.Tezos_client.Keyed.key_name
+          >>= fun _ ->
+          ksprintf
+            (Tezos_client.Keyed.bake state baker_0)
+            "Baker %s bakes %d/%d waiting for next protocol: %S" client.id nth
+            attempts winner
+          >>= fun () ->
+          return
+            (`Not_done
+              (sprintf "Waiting for next_protocol: %S (≠ %s)" winner
+                 Ezjsonm.(to_string (wrap other)))) )
+  >>= fun extra_bakes_waiting_for_next_protocol ->
+  Counter_log.add level_counter "wait-for-next-protocol"
+    extra_bakes_waiting_for_next_protocol ;
+  ( match
+      List.find client_protocols_result#out ~f:(fun prefix ->
+          String.is_prefix winner ~prefix )
+    with
+  | Some p -> Console.say state EF.(wf "The client knows about %s" winner)
+  (* 
+     TODO:
+     - make winner a protocol that the client knows
+     - bake on test chain
+     - test protocol switch
+     - test ≠ not-enough-votes “failures”
+ *)
+  | None ->
+      Console.say state EF.(wf "The client does not know about %s" winner) )
+  >>= fun () ->
+  Interactive_test.Pauser.generic state
+    EF.
+      [ haf "End of Current WIP of the Voting test: SUCCESS \\o/"
+      ; desc
+          (af "Estimated level: %d" (Counter_log.sum level_counter))
+          (markdown_verbatim (Counter_log.to_table_string level_counter)) ]
+  >>= fun () -> return ()
+
+let cmd ~pp_error () =
+  let open Cmdliner in
+  let open Term in
+  Test_command_line.Run_command.make ~pp_error
+    ( pure
+        (fun demo_path
+        node_exec
+        client_exec
+        admin_exec
+        size
+        (`Base_port base_port)
+        (`With_ledger with_ledger)
+        (`Serialize_proposals serialize_proposals)
+        state
+        ->
+          ( state
+          , Interactive_test.Pauser.run_test state ~pp_error
+              (run state ~serialize_proposals ~demo_path ~node_exec ~size
+                 ~admin_exec ~base_port ~client_exec ?with_ledger) ) )
+    $ Arg.(
+        required
+          (pos 0 (some string) None
+             (info [] ~docv:"PROTOCOL-PATH"
+                ~doc:
+                  "The protocol to inject, e.g. `./src/bin_client/test/demo/`.")))
+    $ Tezos_executable.cli_term `Node "tezos"
+    $ Tezos_executable.cli_term `Client "tezos"
+    $ Tezos_executable.cli_term `Admin "tezos"
+    $ Arg.(value (opt int 5 (info ["size"; "S"] ~doc:"Size of the Network.")))
+    $ Arg.(
+        pure (fun p -> `Base_port p)
+        $ value
+            (opt int 46_000
+               (info ["base-port"] ~doc:"Base port number to build upon.")))
+    $ Arg.(
+        pure (fun x -> `With_ledger x)
+        $ value
+            (opt (some string) None
+               (info ["with-ledger"] ~docv:"ledger://..."
+                  ~doc:
+                    "Do the test with a Ledger Nano S as one of the \
+                     bakers/voters.")))
+    $ Arg.(
+        pure (fun x -> `Serialize_proposals x)
+        $ value
+            (flag
+               (info ["serialize-proposals"]
+                  ~doc:
+                    "Run the proposals one-by-one instead of all together \
+                     (preferred by the Ledger).")))
+    $ Test_command_line.cli_state ~name:"voting" () )
+    (let doc = "Sandbox network with a full round of voting." in
+     let man : Manpage.block list =
+       let pf fmt = ksprintf (fun s -> `P s) fmt in
+       [ `S "VOTING TEST"
+       ; pf
+           "This command provides a test which uses a network sandbox to \
+            perform a full round of protocol vote and upgrade. For now, it \
+            goes up to the last block before the protocol switch, baking on \
+            the test chain, and with the new protocol is future work."
+       ; pf
+           "The test can run fully automated unless one uses the \
+            `\"--with-ledger=ledger://...\"` option in which case some steps \
+            have to be interactive." ]
+     in
+     info ~doc ~man "voting")
diff --git a/src/bin_flextesa/dune b/src/bin_flextesa/dune
new file mode 100644
index 000000000000..26cf513eb2a0
--- /dev/null
+++ b/src/bin_flextesa/dune
@@ -0,0 +1,50 @@
+(executables
+  (names main)
+  (public_names flextesa)
+  (libraries tezos-network-sandbox)
+  (flags (:standard -w -9-27-30-32-40@8 -safe-string)))
+
+(alias
+  (name runtest_sandbox_accusations_simple_double_baking)
+  (locks /tcp-port/10000_range)
+  (action
+    (run %{exe:main.exe} accusations simple-double-baking
+         --root-path %{env:ROOT_PATH=/tmp/flextesa-acc-sdb/}
+         --with-timestamp
+         --base-port 10_000
+         --tezos-client-binary %{bin:tezos-client}
+         --tezos-node-binary %{bin:tezos-node} )))
+
+(alias
+  (name runtest_sandbox_accusations_simple_double_endorsing)
+  (locks /tcp-port/10000_range)
+  (action
+    (run %{exe:main.exe} accusations simple-double-endorsing
+         --root-path %{env:ROOT_PATH=/tmp/flextesa-acc-sde/}
+         --with-timestamp
+         --base-port 10_000
+         --tezos-client-binary %{bin:tezos-client}
+         --tezos-node-binary %{bin:tezos-node} )))
+
+(alias
+  (name runtest_sandbox_voting_demo)
+  (locks /tcp-port/30000_range)
+  (action
+    (run %{exe:main.exe} voting
+         ../../../../src/bin_client/test/proto_test_injection
+         --root-path %{env:ROOT_PATH=/tmp/flextesa-voting-demo/}
+         --base-port 30_000
+         --size 3
+         --with-timestamp
+         --tezos-client-binary %{bin:tezos-client}
+         --tezos-admin-client-binary %{bin:tezos-admin-client}
+         --tezos-node-binary %{bin:tezos-node}
+         )))
+
+(alias
+ (name runtest)
+ (deps
+  (alias runtest_sandbox_accusations_simple_double_baking)
+  (alias runtest_sandbox_accusations_simple_double_endorsing)
+   (alias runtest_sandbox_voting_demo)
+   ))
diff --git a/src/bin_flextesa/flextesa.opam b/src/bin_flextesa/flextesa.opam
new file mode 100644
index 000000000000..94cbc0040ee8
--- /dev/null
+++ b/src/bin_flextesa/flextesa.opam
@@ -0,0 +1,20 @@
+opam-version: "2.0"
+version: "dev"
+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-network-sandbox"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
+synopsis: "Tezos: `flextesa` binary"
diff --git a/src/bin_flextesa/main.ml b/src/bin_flextesa/main.ml
new file mode 100644
index 000000000000..cc4763706fce
--- /dev/null
+++ b/src/bin_flextesa/main.ml
@@ -0,0 +1,78 @@
+open Tezos_network_sandbox
+open Internal_pervasives
+
+module Small_utilities = struct
+  let key_of_name_command () =
+    let open Cmdliner in
+    let open Term in
+    ( ( pure (fun n ->
+            let open Tezos_protocol.Account in
+            let account = of_name n in
+            Printf.printf "%s,%s,%s,%s\n%!" (name account) (pubkey account)
+              (pubkey_hash account) (private_key account) )
+      $ Arg.(
+          required
+            (pos 0 (some string) None
+               (info [] ~docv:"NAME" ~doc:"String to generate the data from.")))
+      )
+    , info "key-of-name"
+        ~doc:"Make an unencrypted key-pair deterministically from a string."
+        ~man:
+          [ `P
+              "`flextesa key-of-name hello-world` generates a key-pair of the \
+               `unencrypted:..` kind and outputs it as a 4 values separated \
+               by commas: `name,pub-key,pub-key-hash,private-uri` (hence \
+               compatible with the `--add-bootstrap-account` option of some \
+               of the test scenarios)." ] )
+
+  let netstat_ports ~pp_error () =
+    let open Cmdliner in
+    let open Term in
+    Test_command_line.Run_command.make ~pp_error
+      ( pure (fun state ->
+            ( state
+            , fun () ->
+                Test_scenario.Network.netstat_listening_ports state
+                >>= fun ports ->
+                Console.sayf state
+                  Fmt.(
+                    hvbox ~indent:2 (fun ppf () ->
+                        box words ppf "Netstat listening ports:" ;
+                        sp ppf () ;
+                        box
+                          (list
+                             ~sep:(fun ppf () -> string ppf "," ; sp ppf ())
+                             (fun ppf (p, _) -> fmt "%d" ppf p))
+                          ppf ports )) ) )
+      $ Test_command_line.cli_state ~disable_interactivity:true
+          ~name:"netstat-ports" () )
+      (info "netstat-listening-ports"
+         ~doc:"Like `netstat -nut | awk something-something` but glorified.")
+
+  let all ~pp_error () = [key_of_name_command (); netstat_ports ~pp_error ()]
+end
+
+let () =
+  let open Cmdliner in
+  let help = Term.(ret (pure (`Help (`Auto, None))), info "help") in
+  let pp_error fmt = function
+    | `Scenario_error s -> Format.fprintf fmt "%s" s
+    | #Test_scenario.Inconsistency_error.t as e ->
+        Format.fprintf fmt "%a" Test_scenario.Inconsistency_error.pp e
+    | #Process_result.Error.t as e ->
+        Format.fprintf fmt "%a" Process_result.Error.pp e
+    | `Lwt_exn _ as e -> Format.fprintf fmt "%a" Lwt_exception.pp e
+    | `Sys_error _ as e -> Format.fprintf fmt "%a" System_error.pp e
+    | `Client_command_error _ as e -> Tezos_client.Command_error.pp fmt e
+    | `Admin_command_error _ as e -> Tezos_admin_client.Command_error.pp fmt e
+    | `Waiting_for (msg, `Time_out) ->
+        Format.fprintf fmt "WAITING-FOR “%s”: Time-out" msg
+  in
+  Term.exit
+  @@ Term.eval_choice
+       (help : unit Term.t * _)
+       ( Small_utilities.all ~pp_error ()
+       @ [ Command_mini_network.cmd () ~pp_error
+         ; Command_voting.cmd () ~pp_error
+         ; Command_accusations.cmd () ~pp_error
+         ; Command_prevalidation.cmd () ~pp_error ] )
diff --git a/src/lib_network_sandbox/.ocamlformat b/src/lib_network_sandbox/.ocamlformat
new file mode 100644
index 000000000000..a3d97274f48f
--- /dev/null
+++ b/src/lib_network_sandbox/.ocamlformat
@@ -0,0 +1 @@
+profile=compact
\ No newline at end of file
diff --git a/src/lib_network_sandbox/console.ml b/src/lib_network_sandbox/console.ml
new file mode 100644
index 000000000000..a32db88ed128
--- /dev/null
+++ b/src/lib_network_sandbox/console.ml
@@ -0,0 +1,232 @@
+open Internal_pervasives
+
+type t =
+  { color: bool
+  ; buffer: Buffer.t
+  ; channel: Lwt_io.output_channel
+  ; with_timestamp: bool
+  ; formatter: Format.formatter }
+
+let make with_timestamp color =
+  let channel = Lwt_io.stderr in
+  let b = Buffer.create 42 in
+  let formatter =
+    Format.make_formatter (Buffer.add_substring b) (fun () -> ())
+  in
+  let bold = "\027[01m" in
+  let red = "\027[31m" in
+  let reset = "\027[m" in
+  if color then (
+    let color_of_tag = function
+      | "prompt" -> Some bold
+      | "shout" -> Some red
+      | _ -> None
+    in
+    Format.(
+      pp_set_formatter_tag_functions formatter
+        { mark_open_tag= (fun _ -> "")
+        ; mark_close_tag= (fun _ -> "")
+        ; print_open_tag=
+            (fun tag ->
+              match color_of_tag tag with
+              | Some c -> fprintf formatter "%s" c
+              | None -> () )
+        ; print_close_tag=
+            (fun tag ->
+              if color_of_tag tag <> None then fprintf formatter "%s" reset )
+        } ;
+      pp_set_tags formatter true) ) ;
+  {color; buffer= b; channel; formatter; with_timestamp}
+
+let pp fmt {color; _} = Format.fprintf fmt "@[<2>{Console:@ color: %b}@]" color
+
+let cli_term () =
+  let guess =
+    let dumb =
+      try match Sys.getenv "TERM" with "dumb" | "" -> true | _ -> false
+      with Not_found -> true
+    in
+    let isatty = try Unix.(isatty stderr) with Unix.Unix_error _ -> false in
+    if (not dumb) && isatty then true else false
+  in
+  Cmdliner.(
+    Term.(
+      pure make
+      $ Arg.(
+          value
+            (flag
+               (info ["with-timestamp"]
+                  ~doc:"Display messages with time-stamps.")))
+      $ Arg.(
+          pure (function `Y -> true | `N -> false | `G -> guess)
+          $
+          let answers = [("none", `N); ("yes", `Y); ("auto", `G)] in
+          let doc =
+            sprintf "Control terminal colors (%s)."
+              (String.concat ~sep:", " (List.map answers ~f:fst))
+          in
+          value & opt (enum answers) `G & info ["color"] ~doc)))
+
+let do_output t =
+  Lwt_exception.catch
+    Lwt.(
+      fun () ->
+        Lwt_io.write t.channel (Buffer.contents t.buffer)
+        >>= fun () -> Buffer.clear t.buffer ; return_unit)
+    ()
+
+let sayf (o : _ Base_state.t) (fmt : Format.formatter -> unit -> unit) :
+    (_, _) Asynchronous_result.t =
+  let date =
+    if o#console.with_timestamp then
+      sprintf "[%s]" Tezos_base.Time.(now () |> to_notation)
+    else ""
+  in
+  let ppf = o#console.formatter in
+  Format.(
+    pp_open_hvbox ppf 2 ;
+    pp_open_tag ppf "prompt" ;
+    fprintf ppf "%s%s:" o#application_name date ;
+    pp_close_tag ppf () ;
+    pp_print_break ppf 2 0 ;
+    fmt ppf () ;
+    pp_print_newline ppf () ;
+    pp_close_box ppf () ;
+    pp_print_flush ppf ()) ;
+  do_output o#console
+
+let say (o : _ Base_state.t) ef : (_, _) Asynchronous_result.t =
+  let date =
+    if o#console.with_timestamp then
+      sprintf "[%s]" Tezos_base.Time.(now () |> to_notation)
+    else ""
+  in
+  let msg = EF.(label (ksprintf prompt "%s%s:" o#application_name date) ef) in
+  let fmt = o#console.formatter in
+  Format.(
+    fprintf fmt "%a" Easy_format.Pretty.to_formatter msg ;
+    pp_print_newline fmt () ;
+    pp_print_flush fmt ()) ;
+  do_output o#console
+
+module Prompt = struct
+  type item =
+    { commands: string list
+    ; doc: EF.t
+    ; action:
+           Base.Sexp.t list
+        -> ( [`Help | `Quit | `Loop]
+           , [`Lwt_exn of exn | `Command_line of string] )
+           Asynchronous_result.t }
+
+  let item doc commands action = {commands; doc; action}
+
+  let quit ?(doc = EF.(af "Quit this prompt and continue")) commands =
+    item doc commands (fun _ -> return `Quit)
+
+  let help ?(doc = EF.(af "Display command help")) commands =
+    item doc commands (fun _ -> return `Help)
+
+  let unit_and_loop doc commands f =
+    item doc commands (fun x -> f x >>= fun () -> return `Loop)
+
+  let default_commands () = [quit ["q"; "quit"]; help ["h"; "help"]]
+
+  let command ?(with_defaults = true) state ~commands =
+    let commands =
+      if with_defaults then default_commands () @ commands else commands
+    in
+    let rec loop () =
+      say state EF.(af "Please enter command:")
+      >>= fun () ->
+      Lwt_exception.catch Lwt_io.read_line Lwt_io.stdin
+      >>= fun line ->
+      let open Base.Sexp in
+      match Parsexp.Single.parse_string (sprintf "( %s )" line) with
+      | Ok (List (Atom c :: more)) -> (
+        match
+          List.find commands ~f:(fun m ->
+              List.mem m.commands c ~equal:String.equal )
+        with
+        | Some {action; _} -> (
+            Asynchronous_result.bind_on_error (action more) ~f:(fun err ->
+                say state
+                  EF.(
+                    desc (shout "Error in action:")
+                      (custom (fun fmt ->
+                           Error.pp fmt err ~error:(fun fmt -> function
+                             | `Lwt_exn _ as e -> Lwt_exception.pp fmt e
+                             | `Command_line s ->
+                                 Format.fprintf fmt "Wrong command line: %s" s
+                           ) )))
+                >>= fun () -> return `Loop )
+            >>= function
+            | `Loop -> loop ()
+            | `Help ->
+                say state
+                  EF.(
+                    let cmdlist =
+                      list ~sep:"|" ~delimiters:("[", "]")
+                        ~param:
+                          { default_list with
+                            space_after_separator= false
+                          ; space_before_closing= false
+                          ; space_after_opening= false }
+                    in
+                    label (haf "Commands:")
+                      (list
+                         (List.map commands ~f:(fun {commands; doc; _} ->
+                              label
+                                ~param:
+                                  {default_label with space_after_label= false}
+                                (cmdlist (List.map ~f:(af "%S") commands))
+                                (list [haf "->"; doc]) ))))
+                >>= fun () -> loop ()
+            | `Quit -> return () )
+        | None ->
+            say state
+              EF.(
+                desc
+                  (ksprintf shout "Error, unknown command: %S" c)
+                  (custom (fun fmt -> Base.Sexp.pp_hum_indent 4 fmt (List more))))
+            >>= fun () -> loop () )
+      | Ok other ->
+          say state
+            EF.(
+              desc
+                (shout "Error, cannot understand: ")
+                (custom (fun fmt -> Base.Sexp.pp_hum_indent 4 fmt other)))
+          >>= fun () -> loop ()
+      | Error err ->
+          say state
+            EF.(
+              desc (shout "Error: ")
+                (custom (fun fmt ->
+                     Parsexp.Parse_error.report fmt ~filename:"<command-line>"
+                       err )))
+          >>= fun () -> loop ()
+    in
+    loop ()
+end
+
+let display_errors_of_command state ?(should_output = false) cmd =
+  let outputs () = List.exists cmd#out ~f:(fun s -> String.strip s <> "") in
+  let success =
+    let unix_success = cmd#status = Lwt_unix.WEXITED 0 in
+    if should_output then unix_success && outputs () else unix_success
+  in
+  ( if success then return ()
+  else
+    say state
+      EF.(
+        let output l =
+          match String.concat ~sep:"\n" l |> String.strip with
+          | "" -> af "NONE"
+          | more -> markdown_verbatim more
+        in
+        desc (shout "Error:")
+          (list
+             [ haf "Command %s" (Process_result.status_to_string cmd#status)
+             ; desc (haf "Stdout:") (output cmd#out)
+             ; desc (haf "Stderr:") (output cmd#err) ])) )
+  >>= fun () -> return success
diff --git a/src/lib_network_sandbox/console.mli b/src/lib_network_sandbox/console.mli
new file mode 100644
index 000000000000..0e27e021ce21
--- /dev/null
+++ b/src/lib_network_sandbox/console.mli
@@ -0,0 +1,80 @@
+(** Print messages, and prompt user input from the terminal. *)
+
+open Internal_pervasives
+
+type t =
+  { color: bool
+  ; buffer: Buffer.t
+  ; channel: Lwt_io.output_channel
+  ; with_timestamp: bool
+  ; formatter: Format.formatter }
+
+val make : bool -> bool -> t
+val pp : Format.formatter -> t -> unit
+
+val cli_term : unit -> t Cmdliner.Term.t
+(** {!Cmdliner.Term.t} which configures the console interaction
+    (e.g. the ["--color"] option). *)
+
+val say :
+     < application_name: string ; console: t ; .. >
+  -> Easy_format.t
+  -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+
+val sayf :
+     < application_name: string ; console: t ; .. >
+  -> (Format.formatter -> unit -> unit)
+  -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+
+(** Create interactive prompts. *)
+module Prompt : sig
+  type item =
+    { commands: string list
+    ; doc: Easy_format.t
+    ; action:
+           Sexplib0.Sexp.t list
+        -> ( [`Help | `Loop | `Quit]
+           , [`Command_line of string | `Lwt_exn of exn] )
+           Asynchronous_result.t }
+
+  val item :
+       Easy_format.t
+    -> string list
+    -> (   Sexplib0.Sexp.t list
+        -> ( [`Help | `Loop | `Quit]
+           , [`Command_line of string | `Lwt_exn of exn] )
+           Asynchronous_result.t)
+    -> item
+  (** [item description command_aliases action] creates a command
+      which performs [action]; action gets all the arguments parsed as
+      S-Expressions. *)
+
+  val quit : ?doc:Easy_format.t -> string list -> item
+  val help : ?doc:Easy_format.t -> string list -> item
+
+  val unit_and_loop :
+       Easy_format.t
+    -> string list
+    -> (   Sexplib0.Sexp.t list
+        -> ( unit
+           , [`Command_line of string | `Lwt_exn of exn] )
+           Asynchronous_result.t)
+    -> item
+
+  val default_commands : unit -> item list
+  (** The default commands are !{help} and {!quit}. *)
+
+  val command :
+       ?with_defaults:bool
+    -> < application_name: string ; console: t ; .. >
+    -> commands:item list
+    -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+  (** Prompt for a command among [~commnands]. *)
+end
+
+val display_errors_of_command :
+     < application_name: string ; console: t ; .. >
+  -> ?should_output:bool
+  -> < err: string list ; out: string list ; status: Unix.process_status ; .. >
+  -> (bool, [> `Lwt_exn of exn]) Asynchronous_result.t
+(** Display the results of a command if it fails (see {!Process_result.t}). *)
diff --git a/src/lib_network_sandbox/dune b/src/lib_network_sandbox/dune
new file mode 100644
index 000000000000..8ce69d3e4ff2
--- /dev/null
+++ b/src/lib_network_sandbox/dune
@@ -0,0 +1,16 @@
+(library
+ (name tezos_network_sandbox)
+ (public_name tezos-network-sandbox)
+ (flags (:standard -safe-string))
+ (libraries
+    lwt.unix
+    cmdliner
+    easy-format
+    tezos-stdlib-unix
+    dum
+    base
+    genspio
+    ezjsonm
+    tezos-signer-backends
+    tezos-client-alpha))
+
diff --git a/src/lib_network_sandbox/helpers.ml b/src/lib_network_sandbox/helpers.ml
new file mode 100644
index 000000000000..ad8c324151c6
--- /dev/null
+++ b/src/lib_network_sandbox/helpers.ml
@@ -0,0 +1,85 @@
+open Internal_pervasives
+open Console
+
+let dump_connection =
+  let open EF in
+  let open Tezos_node in
+  function
+  | `Duplex (na, nb) ->
+      af "%s:%d <-> %s:%d" na.id na.p2p_port nb.id nb.p2p_port
+  | `From_to (na, nb) ->
+      haf "%s:%d --> %s:%d" na.id na.p2p_port nb.id nb.p2p_port
+  | `Missing (na, int) ->
+      ksprintf shout "%s:%d --> ???:%d" na.id na.p2p_port int
+
+let dump_connections state nodes =
+  let conns = Tezos_node.connections nodes in
+  say state
+    (let open EF in
+    desc_list (haf "Connections:") (List.map conns ~f:dump_connection))
+
+let clear_root state =
+  let root = Paths.(root state) in
+  Lwt_exception.catch
+    (fun () -> ksprintf Lwt_unix.system "rm -fr %s" (Filename.quote root))
+    ()
+  >>= function
+  | Unix.WEXITED 0 -> return ()
+  | _ -> System_error.fail "cannot delete root path (%S)" root
+
+let wait_for state ~attempts ~seconds f =
+  let rec attempt nth =
+    let again () = attempt (nth + 1) in
+    f nth
+    >>= function
+    | `Done x -> return x
+    | `Not_done msg when nth < attempts ->
+        say state
+          EF.(
+            wf "%s: attempt %d/%d, sleeping %.02f seconds" msg nth attempts
+              seconds)
+        >>= fun () -> System.sleep seconds >>= fun () -> again ()
+    | `Not_done msg -> fail (`Waiting_for (msg, `Time_out))
+  in
+  attempt 1
+
+let kill_node state nod =
+  Running_processes.find_process_by_id ~only_running:true state
+    ~f:(( = ) nod.Tezos_node.id)
+  >>= fun states ->
+  ( match states with
+  | [one] -> return one
+  | _ -> System_error.fail "Expecting one state for node %s" nod.Tezos_node.id
+  )
+  >>= fun node_state_0 -> Running_processes.kill state node_state_0
+
+let restart_node ~client_exec state nod =
+  Running_processes.start state (Tezos_node.process state nod)
+  >>= fun _ ->
+  let client = Tezos_client.of_node nod ~exec:client_exec in
+  say state
+    EF.(wf "Started node %s, waiting for bootstrap …" nod.Tezos_node.id)
+  >>= fun () -> Tezos_client.bootstrapped client ~state
+
+module Counter_log = struct
+  type t = (string * int) list ref
+
+  let create () = ref []
+  let add t s n = t := (s, n) :: !t
+  let incr t s = add t s 1
+  let sum t = List.fold !t ~init:0 ~f:(fun prev (_, s) -> prev + s)
+
+  let to_table_string t =
+    let total = "**Total:**" in
+    let longest =
+      List.fold !t ~init:total ~f:(fun p (n, _) ->
+          if String.length p < String.length n then n else p )
+    in
+    List.rev_map
+      ((total, sum t) :: !t)
+      ~f:(fun (cmt, n) ->
+        sprintf "| %s %s|% 8d|" cmt
+          (String.make (String.length longest - String.length cmt + 2) '.')
+          n )
+    |> String.concat ~sep:"\n"
+end
diff --git a/src/lib_network_sandbox/helpers.mli b/src/lib_network_sandbox/helpers.mli
new file mode 100644
index 000000000000..281b8a2f9342
--- /dev/null
+++ b/src/lib_network_sandbox/helpers.mli
@@ -0,0 +1,58 @@
+(** Generic testing helpers *)
+
+open Internal_pervasives
+
+val dump_connections :
+     < application_name: string ; console: Console.t ; .. >
+  -> Tezos_node.t list
+  -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+(** Display all the P2P connections of a set of nodes, see
+    {!Tezos_node.connections}. *)
+
+val clear_root :
+     < paths: Paths.t ; .. >
+  -> (unit, [> `Lwt_exn of exn | `Sys_error of string]) Asynchronous_result.t
+(** Remove (["rm -fr .."]) the root-path of the current [state]. *)
+
+val wait_for :
+     < application_name: string ; console: Console.t ; .. >
+  -> attempts:int
+  -> seconds:float
+  -> (   int
+      -> ( [`Done of 'a | `Not_done of string]
+         , ([> `Lwt_exn of exn | `Waiting_for of string * [`Time_out]]
+            as
+            'errors) )
+         Asynchronous_result.t)
+  -> ('a, 'errors) Asynchronous_result.t
+(** Try to wait for an event. *)
+
+val kill_node :
+     < runner: Running_processes.State.t ; .. >
+  -> Tezos_node.t
+  -> (unit, [> `Lwt_exn of exn | `Sys_error of string]) Asynchronous_result.t
+(** Kill a node's process. *)
+
+val restart_node :
+     client_exec:[`Client] Tezos_executable.t
+  -> < application_name: string
+     ; console: Console.t
+     ; paths: Paths.t
+     ; runner: Running_processes.State.t
+     ; .. >
+  -> Tezos_node.t
+  -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+(** Restart a killed node. *)
+
+(** Stateful “message × count” log, see its use in, e.g.,
+    ["./src/bin_flextesa/command_voting.ml"] where baked-levels
+    are accumulated and then displayed. . *)
+module Counter_log : sig
+  type t
+
+  val create : unit -> t
+  val add : t -> string -> int -> unit
+  val incr : t -> string -> unit
+  val sum : t -> int
+  val to_table_string : t -> string
+end
diff --git a/src/lib_network_sandbox/interactive_test.ml b/src/lib_network_sandbox/interactive_test.ml
new file mode 100644
index 000000000000..3d304c21b523
--- /dev/null
+++ b/src/lib_network_sandbox/interactive_test.ml
@@ -0,0 +1,492 @@
+open Internal_pervasives
+open Console
+
+module Commands = struct
+  let cmdline_fail fmt = Format.kasprintf (fun s -> fail (`Command_line s)) fmt
+
+  let no_args = function
+    | [] -> return ()
+    | _more -> cmdline_fail "this command expects no arguments"
+
+  let flag f sexps = List.mem sexps (Base.Sexp.Atom f) ~equal:Base.Sexp.equal
+
+  let unit_loop_no_args doc opts f =
+    Prompt.unit_and_loop doc opts (fun sexps ->
+        no_args sexps >>= fun () -> f () )
+
+  module Sexp_options = struct
+    let option_doc pattern doc = EF.(desc (haf "`%s`:" pattern) doc)
+    let option_list_doc l = EF.(desc_list (wf "Options:") l)
+
+    let port_number_doc _ ~default_port =
+      option_doc "(port <int>)"
+        EF.(wf "use port-number <int> (default: %d)" default_port)
+
+    let port_number state ~default_port sexps =
+      match
+        List.find_map sexps
+          ~f:
+            Base.Sexp.(
+              function
+              | List [Atom "port"; Atom p] -> (
+                try Some (`Ok (Int.of_string p))
+                with _ -> Some (`Not_an_int p) )
+              | List (Atom "port" :: other) -> Some (`Wrong_option other)
+              | _other -> None)
+      with
+      | None -> return default_port
+      | Some (`Ok p) -> return p
+      | Some ((`Not_an_int _ | `Wrong_option _) as other) ->
+          say state
+            EF.(
+              desc
+                (shout "Error parsing port option:")
+                ( match other with
+                | `Not_an_int s ->
+                    af "This is not an integer: %S, using default: %d" s
+                      default_port
+                | `Wrong_option _sexps ->
+                    af "Usage (port <int>), using default: %d" default_port ))
+          >>= fun () -> return default_port
+  end
+
+  let du_sh_root state =
+    unit_loop_no_args
+      EF.(af "Run du -sh on %s" (Paths.root state))
+      ["d"; "du-root"]
+      (fun () ->
+        Running_processes.run_cmdf state "du -sh %s" (Paths.root state)
+        >>= fun du ->
+        display_errors_of_command state du
+        >>= function
+        | true ->
+            say state
+              EF.(
+                desc (haf "Disk-Usage:")
+                  (af "%s" (String.concat ~sep:" " du#out)))
+        | false -> return () )
+
+  let processes state =
+    Prompt.unit_and_loop
+      EF.(
+        af "Display status of processes-manager ('all' to include non-running)")
+      ["p"; "processes"]
+      (fun sxp ->
+        let all = flag "all" sxp in
+        say state (Running_processes.ef ~all state) )
+
+  let curl ?(jq = ".") state ~port ~path =
+    Running_processes.run_cmdf state "curl http://localhost:%d%s | jq %s" port
+      path jq
+    >>= fun curl_res ->
+    display_errors_of_command state curl_res ~should_output:true
+    >>= function
+    | true -> return (`Success curl_res#out) | false -> return `Error
+
+  let curl_unit_display ?jq state cmd ~default_port ~path ~doc =
+    Prompt.unit_and_loop
+      EF.(
+        desc (af "%s" doc)
+          (desc_list (af "Options:")
+             [Sexp_options.port_number_doc state ~default_port]))
+      cmd
+      (fun sexps ->
+        Sexp_options.port_number state sexps ~default_port
+        >>= fun port ->
+        curl ?jq state ~port ~path
+        >>= function
+        | `Success res ->
+            say state
+              EF.(
+                desc (af "Curl-Node :%d" port)
+                  (af "\"%s\"" (String.concat ~sep:"\n" res)))
+        | `Error -> return () )
+
+  let curl_metadata state ~default_port =
+    curl_unit_display state ["m"; "metadata"] ~default_port
+      ~path:"/chains/main/blocks/head/metadata"
+      ~doc:"Display `/chains/main/blocks/head/metadata`"
+
+  let curl_level state ~default_port =
+    curl_unit_display state ["l"; "level"] ~default_port
+      ~path:"/chains/main/blocks/head/metadata" ~doc:"Display block level"
+      ~jq:".level"
+
+  let curl_baking_rights state ~default_port =
+    curl_unit_display state ["bk"; "baking-rights"] ~default_port
+      ~path:"/chains/main/blocks/head/helpers/baking_rights"
+      ~doc:"Display baking rights"
+
+  let all_levels state ~nodes =
+    unit_loop_no_args
+      EF.(af "Get all the levels")
+      ["al"; "all-levels"]
+      (fun () ->
+        Test_scenario.Queries.all_levels state ~nodes
+        >>= fun results ->
+        say state
+          EF.(
+            desc (af "Node-levels:")
+              (list
+                 (List.map results ~f:(fun (id, result) ->
+                      desc (haf "%s" id)
+                        ( match result with
+                        | `Failed -> af "Failed"
+                        | `Level i -> af "[%d]" i
+                        | `Null -> af "{Null}"
+                        | `Unknown s -> af "¿%s?" s ) )))) )
+
+  let show_process state =
+    Prompt.unit_and_loop
+      EF.(af "Show more of a process (by name-prefix)")
+      ["show"]
+      (function
+        | [Atom name] ->
+            let prefix = String.lowercase name in
+            Running_processes.find_process_by_id state ~f:(fun n ->
+                String.is_prefix (String.lowercase n) ~prefix )
+            >>= fun procs ->
+            List.fold procs ~init:(return []) ~f:(fun prevm {process; lwt} ->
+                prevm
+                >>= fun prev ->
+                let open Running_processes in
+                let out = output_path state process `Stdout in
+                let err = output_path state process `Stderr in
+                Running_processes.run_cmdf state "tail %s" out
+                >>= fun tailout ->
+                Running_processes.run_cmdf state "tail %s" err
+                >>= fun tailerr ->
+                return
+                  EF.(
+                    desc_list
+                      (haf "%S (%d)" process.Process.id lwt#pid)
+                      [ desc (af "out: %s" out) (ocaml_string_list tailout#out)
+                      ; desc (af "err: %s" err) (ocaml_string_list tailerr#out)
+                      ]
+                    :: prev) )
+            >>= fun ef -> say state EF.(list ef)
+        | _other -> cmdline_fail "command expects 1 argument: name-prefix")
+
+  let kill_all state =
+    unit_loop_no_args
+      EF.(af "Kill all processes.")
+      ["ka"; "killall"]
+      (fun () -> Running_processes.kill_all state)
+
+  let secret_keys state ~protocol =
+    unit_loop_no_args
+      EF.(af "Show the protocol's “bootstrap” accounts")
+      ["boa"; "bootstrap-accounts"]
+      (fun () ->
+        say state
+          EF.(
+            desc (af "Secret Keys:")
+              (ocaml_list
+                 (List.map (Tezos_protocol.bootstrap_accounts protocol)
+                    ~f:(fun acc ->
+                      let open Tezos_protocol.Account in
+                      ocaml_tuple
+                        [ atom (name acc)
+                        ; af "Pub:%s" (pubkey acc)
+                        ; af "Hash:%s" (pubkey_hash acc)
+                        ; atom (private_key acc) ] )))) )
+
+  let show_connections state nodes =
+    unit_loop_no_args
+      EF.(af "Show all node connections")
+      ["ac"; "all-connections"]
+      (fun () -> Helpers.dump_connections state nodes)
+
+  let balances state ~default_port =
+    Prompt.unit_and_loop
+      EF.(
+        desc
+          (wf "Show the balances of all known accounts")
+          (desc_list (wf "Options")
+             [Sexp_options.port_number_doc state ~default_port]))
+      ["sb"; "show-balances"]
+      (fun sexps ->
+        Sexp_options.port_number state sexps ~default_port
+        >>= fun port ->
+        curl state ~port ~path:"/chains/main/blocks/head/context/contracts"
+        >>= (function
+              | `Success res -> (
+                try
+                  let json =
+                    Ezjsonm.from_string (String.concat ~sep:"\n" res)
+                  in
+                  let contracts =
+                    match json with
+                    | `A sl ->
+                        List.map sl ~f:(function
+                          | `String s -> s
+                          | _ -> failwith "Not a string list" )
+                    | _ -> failwith "Not a string list"
+                  in
+                  return contracts
+                with e ->
+                  say state
+                    EF.(
+                      desc_list
+                        (shout "Found not contracts!")
+                        [ desc (af "output") (ocaml_string_list res)
+                        ; desc (af "exn") (exn e) ])
+                  >>= fun () -> return [] )
+              | `Error -> return [])
+        >>= fun contracts ->
+        let balance block contract =
+          let path =
+            sprintf "/chains/main/blocks/%s/context/contracts/%s/balance" block
+              contract
+          in
+          curl state ~port ~path
+          >>= function
+          | `Success res -> return (Some (String.concat ~sep:"" res))
+          | `Error -> return None
+        in
+        List.fold contracts ~init:(return []) ~f:(fun prevm hsh ->
+            prevm
+            >>= fun prev ->
+            balance "1" hsh
+            >>= fun init ->
+            balance "head" hsh
+            >>= fun current -> return ((hsh, init, current) :: prev) )
+        >>= fun results ->
+        say state
+          EF.(
+            desc_list
+              (af "Balances (from :%d)" port)
+              (List.map results ~f:(fun (hsh, init, cur) ->
+                   desc (haf "%S" hsh)
+                     (af "%s → %s"
+                        (Option.value init ~default:"???")
+                        (Option.value cur ~default:"???")) ))) )
+
+  let arbitrary_command_on_clients ?make_admin
+      ?(command_names = ["cc"; "client-command"]) state ~clients =
+    Prompt.unit_and_loop
+      EF.(
+        desc
+          (wf "Run a tezos-client command on %s"
+             ( match clients with
+             | [] -> "NO CLIENT, so this is useless…"
+             | [one] -> sprintf "the %S client." one.Tezos_client.id
+             | more ->
+                 sprintf "all the following clients: %s."
+                   ( List.map more ~f:(fun c -> c.Tezos_client.id)
+                   |> String.concat ~sep:", " ) ))
+          Sexp_options.(
+            option_list_doc
+              [ option_doc "(only <name1> <name2>)"
+                  (wf "Restrict the clients by name")
+              ; option_doc "(admin)"
+                  (wf "Use the admin-client instead%s"
+                     (match make_admin with None -> " (DISABLED)" | _ -> ""))
+              ]))
+      command_names
+      (fun sexps ->
+        let args =
+          let open Base.Sexp in
+          List.filter_map sexps ~f:(function Atom s -> Some s | _ -> None)
+        in
+        let subset_of_clients =
+          let open Base.Sexp in
+          List.find_map sexps ~f:(function
+            | List (Atom "only" :: l) ->
+                Some
+                  (List.map l ~f:(function
+                    | Atom a -> a
+                    | other ->
+                        ksprintf failwith
+                          "Option `only` only accepts a list of names: %s"
+                          (to_string_hum other) ))
+            | _ -> None )
+          |> function
+          | None -> clients
+          | Some more ->
+              List.filter clients ~f:(fun c ->
+                  List.mem more c.Tezos_client.id ~equal:String.equal )
+        in
+        let use_admin =
+          match make_admin with
+          | None -> `Client
+          | Some of_client ->
+              if
+                List.exists sexps
+                  ~f:
+                    Base.Sexp.(
+                      function List [Atom "admin"] -> true | _ -> false)
+              then `Admin of_client
+              else `Client
+        in
+        List.fold ~init:(return []) subset_of_clients ~f:(fun prevm client ->
+            prevm
+            >>= fun prev ->
+            Running_processes.run_cmdf state "sh -c %s"
+              ( ( match use_admin with
+                | `Client -> Tezos_client.client_command client ~state args
+                | `Admin mkadm ->
+                    Tezos_admin_client.make_command (mkadm client) state args
+                )
+              |> Genspio.Compile.to_one_liner |> Filename.quote )
+            >>= fun res ->
+            display_errors_of_command state res
+            >>= function
+            | true -> return ((client, String.concat ~sep:"\n" res#out) :: prev)
+            | false -> return prev )
+        >>= fun results ->
+        let different_results =
+          List.dedup_and_sort results ~compare:(fun (_, a) (_, b) ->
+              String.compare a b )
+        in
+        say state
+          EF.(
+            desc_list (af "Done")
+              [ desc (haf "Command:")
+                  (ocaml_string_list
+                     ( ( match use_admin with
+                       | `Client -> "<client>"
+                       | `Admin _ -> "<admin>" )
+                     :: args ))
+              ; desc (haf "Results")
+                  (list
+                     (List.map different_results ~f:(fun (_, res) ->
+                          let clients =
+                            List.filter_map results ~f:(function
+                              | c, r when res = r -> Some c.Tezos_client.id
+                              | _ -> None )
+                          in
+                          desc
+                            (haf "Client%s %s:"
+                               ( if List.length subset_of_clients = 1 then ""
+                               else "s" )
+                               (String.concat ~sep:", " clients))
+                            (markdown_verbatim res) ))) ]) )
+
+  let all_defaults state ~nodes =
+    let default_port = (List.hd_exn nodes).Tezos_node.rpc_port in
+    [ du_sh_root state; processes state
+    ; show_connections state nodes
+    ; curl_level state ~default_port
+    ; balances state ~default_port
+    ; curl_metadata state ~default_port
+    ; curl_baking_rights state ~default_port
+    ; all_levels state ~nodes; show_process state; kill_all state ]
+end
+
+module Interactivity = struct
+  type t = [`Full | `None | `On_error | `At_end]
+
+  let is_interactive (state : < test_interactivity: t ; .. >) =
+    state#test_interactivity = `Full
+
+  let pause_on_error state =
+    match state#test_interactivity with
+    | `Full | `On_error | `At_end -> true
+    | `None -> false
+
+  let pause_on_success state =
+    match state#test_interactivity with
+    | `Full | `At_end -> true
+    | `None | `On_error -> false
+
+  let cli_term ?(default : t = `None) () =
+    let open Cmdliner in
+    Term.(
+      pure (fun interactive pause_end pause_error ->
+          match (interactive, pause_end, pause_error) with
+          | true, _, _ -> `Full
+          | false, true, _ -> `At_end
+          | false, false, true -> `At_end
+          | false, false, false -> `None )
+      $ Arg.(
+          value
+          & opt bool
+              ( match default with
+              | `None | `On_error | `At_end -> false
+              | `Full -> true )
+          & info ["interactive"] ~doc:"Add all pauses with command prompts.")
+      $ Arg.(
+          value
+          & opt bool
+              ( match default with
+              | `None | `On_error -> false
+              | `At_end | `Full -> true )
+          & info ["pause-at-end"]
+              ~doc:"Add a pause with a command prompt at the end of the test.")
+      $ Arg.(
+          value
+          & opt bool
+              ( match default with
+              | `None -> false
+              | `At_end | `Full | `On_error -> true )
+          & info ["pause-on-error"]
+              ~doc:
+                "Add a pause with a command prompt at the end of the test, \
+                 only in case of test failure."))
+end
+
+module Pauser = struct
+  type t =
+    {mutable extra_commands: Prompt.item list; default_end: [`Sleep of float]}
+
+  let make ?(default_end = `Sleep 2.) extra_commands =
+    {extra_commands; default_end}
+
+  let commands state = state#pauser.extra_commands
+  let default_end state = state#pauser.default_end
+
+  let add_commands state cl =
+    state#pauser.extra_commands <- commands state @ cl
+
+  let generic state ?(force = false) msgs =
+    let do_pause = Interactivity.is_interactive state || force in
+    say state
+      EF.(
+        desc
+          (if do_pause then haf "Pause" else haf "Not pausing")
+          (list ~param:{default_list with space_before_separator= false} msgs))
+    >>= fun () ->
+    if do_pause then Prompt.(command state ~commands:(commands state))
+    else return ()
+
+  let run_test state f ~pp_error () =
+    let finish () =
+      say state EF.(af "Killing all processes.")
+      >>= fun () ->
+      Running_processes.kill_all state
+      >>= fun () ->
+      say state EF.(af "Waiting for processes to all die.")
+      >>= fun () -> Running_processes.wait_all state
+    in
+    Sys.catch_break false ;
+    let cond = Lwt_condition.create () in
+    let _ =
+      Lwt_unix.on_signal Sys.sigint (fun i ->
+          Printf.eprintf "SIGINTED (%d)\n%!" i ;
+          Lwt_condition.broadcast cond `Sigint )
+    in
+    let wait () =
+      Lwt_exception.catch Lwt_condition.wait cond
+      >>= fun `Sigint -> Lwt_exception.fail (Failure "Interrupted")
+    in
+    Dbg.e
+      EF.(wf "Running test %s on %s" state#application_name (Paths.root state)) ;
+    Asynchronous_result.bind_on_error
+      ( (try Lwt.pick [f (); wait ()] with e -> fail (`Lwt_exn e))
+      >>= fun () ->
+      ( match (Interactivity.pause_on_success state, default_end state) with
+      | true, _ -> generic state ~force:true EF.[af "Scenario done; pausing"]
+      | false, `Sleep n ->
+          say state EF.(wf "Test done, sleeping %.02f seconds" n)
+          >>= fun () -> System.sleep n )
+      >>= fun () -> finish () )
+      ~f:(fun {error_value; attachments} ->
+        generic state
+          ~force:(Interactivity.pause_on_error state)
+          EF.
+            [ haf "Last pause before the test will Kill 'Em All and Quit."
+            ; desc (shout "Error:") (af "%a" pp_error error_value) ]
+        >>= fun () ->
+        finish () >>= fun () -> fail error_value ~attach:attachments )
+end
diff --git a/src/lib_network_sandbox/interactive_test.mli b/src/lib_network_sandbox/interactive_test.mli
new file mode 100644
index 000000000000..93027f47946a
--- /dev/null
+++ b/src/lib_network_sandbox/interactive_test.mli
@@ -0,0 +1,194 @@
+(** Tools to manage interactivity in test scenarios. *)
+
+open Internal_pervasives
+
+(** Implementations of common {!Console.Prompt.item}. *)
+module Commands : sig
+  val cmdline_fail :
+       ( 'a
+       , Format.formatter
+       , unit
+       , ('b, [> `Command_line of string]) Asynchronous_result.t )
+       format4
+    -> 'a
+
+  val no_args :
+    'a list -> (unit, [> `Command_line of string]) Asynchronous_result.t
+
+  val flag : string -> Sexplib0.Sexp.t list -> bool
+
+  val unit_loop_no_args :
+       Easy_format.t
+    -> string list
+    -> (   unit
+        -> ( unit
+           , [`Command_line of string | `Lwt_exn of exn] )
+           Asynchronous_result.t)
+    -> Console.Prompt.item
+
+  val du_sh_root :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> Console.Prompt.item
+
+  val processes :
+       < application_name: string
+       ; console: Console.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> Console.Prompt.item
+
+  val curl :
+       ?jq:string
+    -> < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> port:int
+    -> path:string
+    -> ( [> `Error | `Success of string list]
+       , [> `Lwt_exn of exn] )
+       Asynchronous_result.t
+
+  val curl_unit_display :
+       ?jq:string
+    -> < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> string list
+    -> default_port:int
+    -> path:string
+    -> doc:string
+    -> Console.Prompt.item
+
+  val curl_metadata :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> default_port:int
+    -> Console.Prompt.item
+
+  val curl_level :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> default_port:int
+    -> Console.Prompt.item
+
+  val curl_baking_rights :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> default_port:int
+    -> Console.Prompt.item
+
+  val all_levels :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> nodes:Tezos_node.t list
+    -> Console.Prompt.item
+
+  val show_process :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> Console.Prompt.item
+
+  val kill_all :
+    < runner: Running_processes.State.t ; .. > -> Console.Prompt.item
+
+  val secret_keys :
+       < application_name: string ; console: Console.t ; .. >
+    -> protocol:Tezos_protocol.t
+    -> Console.Prompt.item
+
+  val arbitrary_command_on_clients :
+       ?make_admin:(Tezos_client.t -> Tezos_admin_client.t)
+    -> ?command_names:string list
+    -> < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> clients:Tezos_client.t list
+    -> Console.Prompt.item
+
+  val all_defaults :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> nodes:Tezos_node.t list
+    -> Console.Prompt.item list
+end
+
+(** Configurable (through {!Cmdliner.Term.t}) interactivity of
+    test-scenarios. *)
+module Interactivity : sig
+  type t = [`Full | `None | `On_error | `At_end]
+
+  val pause_on_error : < test_interactivity: t ; .. > -> bool
+  val pause_on_success : < test_interactivity: t ; .. > -> bool
+  val is_interactive : < test_interactivity: t ; .. > -> bool
+  val cli_term : ?default:t -> unit -> t Cmdliner.Term.t
+end
+
+(** A {!Pauser.t} is tool to include optional prompting pauses in
+    test-scenarios. *)
+module Pauser : sig
+  type t = private
+    { mutable extra_commands: Console.Prompt.item list
+    ; default_end: [`Sleep of float] }
+
+  val make : ?default_end:[`Sleep of float] -> Console.Prompt.item list -> t
+
+  val add_commands : < pauser: t ; .. > -> Console.Prompt.item list -> unit
+  (** Add commands to the current pauser. *)
+
+  val generic :
+       < application_name: string
+       ; console: Console.t
+       ; pauser: t
+       ; test_interactivity: Interactivity.t
+       ; .. >
+    -> ?force:bool
+    -> Easy_format.t list
+    -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+  (** Pause the test according to [state#interactivity] (overridden
+      with [~force:true]), the pause displays the list of
+      {!Easy_format.t}s and prompts the user for commands (see
+      {!add_commands}). *)
+
+  val run_test :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; pauser: t
+       ; runner: Running_processes.State.t
+       ; test_interactivity: Interactivity.t
+       ; .. >
+    -> (unit -> (unit, ([> `Lwt_exn of exn] as 'errors)) Asynchronous_result.t)
+    -> pp_error:(Format.formatter -> 'errors -> unit)
+    -> unit
+    -> (unit, 'errors) Asynchronous_result.t
+  (** Run a test-scenario and deal with potential errors according
+      to [state#test_interactivity]. *)
+end
diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml
new file mode 100644
index 000000000000..0354af42da3b
--- /dev/null
+++ b/src/lib_network_sandbox/internal_pervasives.ml
@@ -0,0 +1,272 @@
+(** Local “Pervasives” module for flextesa.
+
+See also ["docs/tutorials/flextesa.rst"]. *)
+
+module List = Base.List
+module String = Base.String
+module Option = Base.Option
+module Int = Base.Int
+module Float = Base.Float
+module Exn = Base.Exn
+
+let ( // ) = Filename.concat
+let ksprintf, sprintf = Printf.(ksprintf, sprintf)
+
+(** Wrapper around the [EasyFormat] library to use for console display. *)
+module EF = struct
+  type t = Easy_format.t
+
+  open Easy_format
+
+  let default_list = list
+  let default_atom = atom
+  let default_label = label
+  let atom ?(param = default_atom) s = Atom (s, param)
+  let label ?(param = label) a b = Label ((a, param), b)
+
+  let list ?(delimiters = ("", "")) ?(sep = "") ?(param = default_list) l =
+    List ((fst delimiters, sep, snd delimiters, param), l)
+
+  let ocaml_list = list ~delimiters:("[", "]") ~sep:";"
+
+  let ocaml_tuple =
+    list ~delimiters:("(", ")") ~sep:","
+      ~param:
+        { default_list with
+          space_after_opening= false; space_before_closing= false }
+
+  let shout = atom ~param:{atom_style= Some "shout"}
+  let prompt = atom ~param:{atom_style= Some "prompt"}
+  let highlight = atom ~param:{atom_style= Some "prompt"}
+  let custom pr = Custom pr
+  let pr f = custom (fun ppf -> f (Format.fprintf ppf))
+  let desc_list s l = label s (list ~sep:"," l)
+  let desc s v = label s v
+  let af ?param fmt = Format.kasprintf (atom ?param) fmt
+
+  let wrap s =
+    String.split ~on:' ' s |> List.map ~f:String.strip
+    |> List.filter ~f:(( <> ) "")
+    |> List.map ~f:atom |> list
+
+  let wf fmt = Format.kasprintf wrap fmt
+  let haf fmt = Format.kasprintf highlight fmt
+  let opt f = function None -> atom "-" | Some o -> f o
+  let ocaml_string_list l = ocaml_list (ListLabels.map l ~f:(af "%S"))
+  let exn e = wf "%a" Exn.pp e
+
+  let markdown_verbatim ?(guard_length = 80) s =
+    let guard = String.make guard_length '`' in
+    af "\n%s\n%s\n%s@." guard s guard
+
+  let ef_json msg json =
+    desc (haf "%s" msg) (markdown_verbatim Ezjsonm.(to_string (wrap json)))
+end
+
+(** Debug-display module (non-cooperative output to [stderr]). *)
+module Dbg = struct
+  let e ef =
+    EF.(
+      list ~delimiters:("<DBG|", "|DBG>") ~sep:""
+        ~param:
+          { default_list with
+            separator_style= Some "debug"
+          ; align_closing= true
+          ; space_after_opening= true
+          ; space_before_closing= true }
+        [ef]
+      |> Easy_format.Pretty.to_stderr) ;
+    Printf.eprintf "\n%!"
+
+  let i (e : EF.t) = ignore e
+  let f f = e (EF.pr f)
+  let any v = Dum.to_eformat v
+  let pp_any fmt v = Dum.to_formatter fmt v
+end
+
+(** An “typed error type” based on polymorphic variants *)
+module Error = struct
+  type +'a t =
+    {error_value: 'a; attachments: (string * string) list}
+    constraint 'a = [> ]
+
+  let make ?(attach = []) error_value = {error_value; attachments= attach}
+
+  let pp ~error fmt {error_value; attachments} =
+    EF.(
+      label (shout "Error: ")
+        (list
+           [ custom (fun fmt -> error fmt error_value)
+           ; ocaml_list
+               (List.map attachments ~f:(fun (k, v) ->
+                    ocaml_tuple [atom k; atom v] )) ])
+      |> Easy_format.Pretty.to_formatter fmt)
+end
+
+(** A wrapper around [('ok, 'a Error.t) result Lwt.t]. *)
+module Asynchronous_result = struct
+  type ('ok, 'a) t = ('ok, 'a Error.t) result Lwt.t
+
+  let return o : (_, _) t = Lwt.return (Ok o)
+
+  let yield () =
+    (* https://github.com/ocsigen/lwt/issues/631 *)
+    if false then Lwt_unix.auto_yield 0.005 () else Lwt_main.yield ()
+
+  let fail ?attach error_value : (_, _) t =
+    Lwt.return (Error (Error.make ?attach error_value))
+
+  let bind (o : (_, _) t) f : (_, _) t =
+    let open Lwt.Infix in
+    o
+    >>= function
+    | Ok o -> yield () >>= fun () -> f o | Error _ as e -> Lwt.return e
+
+  let bind_on_error (o : (_, _) t) ~f : (_, _) t =
+    Lwt.bind o (function Ok o -> return o | Error e -> f e)
+
+  let transform_error o ~f =
+    Lwt.bind o (function
+      | Ok o -> return o
+      | Error {Error.error_value; attachments} -> f error_value attachments )
+
+  let bind_on_result :
+         ('ok, 'error) t
+      -> f:(('ok, 'error Error.t) result -> ('ok2, 'error2) t)
+      -> ('ok2, 'error2) t =
+   fun o ~f -> Lwt.bind o f
+
+  (** The module opened everywhere. *)
+  module Std = struct let ( >>= ) = bind let return = return let fail = fail
+  end
+
+  open Std
+
+  let run r on_error =
+    match Lwt_main.run (r ()) with Ok o -> o | Error e -> on_error e
+
+  let die n = fail (`Die n)
+
+  module List_sequential = struct
+    let iter l ~f =
+      List.fold l ~init:(return ()) ~f:(fun pm x ->
+          pm >>= fun () -> (f x : (_, _) t) )
+
+    let iteri l ~f =
+      List.fold l ~init:(return 0) ~f:(fun pm x ->
+          pm >>= fun n -> (f n x : (_, _) t) >>= fun () -> return (n + 1) )
+      >>= fun _ -> return ()
+  end
+
+  let map_option o ~f =
+    match o with
+    | None -> return None
+    | Some s -> f s >>= fun o -> return (Some o)
+
+  module Loop = struct
+    let n_times times f =
+      let rec loop n =
+        match n with
+        | n when n <= 0 -> return ()
+        | n -> f (1 + times - n) >>= fun () -> loop (n - 1)
+      in
+      loop times
+  end
+
+  let run_application r =
+    match Lwt_main.run (r ()) with
+    | Ok () -> exit 0
+    | Error {Error.error_value= `Die ret; _} -> exit ret
+end
+
+include Asynchronous_result.Std
+module List_sequential = Asynchronous_result.List_sequential
+module Loop = Asynchronous_result.Loop
+
+module Lwt_exception = struct
+  let fail ?attach (e : exn) = fail ?attach (`Lwt_exn e)
+
+  let catch ?attach f x =
+    Lwt.catch
+      (fun () -> Lwt.bind (f x) @@ fun r -> return r)
+      (fun exn -> fail ?attach exn)
+
+  let pp fmt (`Lwt_exn e) =
+    Format.fprintf fmt "LWT-Exception:@ %s" (Printexc.to_string e)
+end
+
+module System_error = struct
+  let fail ?attach fmt = ksprintf (fun e -> fail ?attach (`Sys_error e)) fmt
+  let pp fmt (`Sys_error e) = Format.fprintf fmt "System-error:@ %s" e
+end
+
+(** A wrapper around a structural type describing the result of
+    external processes. *)
+module Process_result = struct
+  type t =
+    < err: string list ; out: string list ; status: Unix.process_status >
+
+  let status_to_string s =
+    Lwt_unix.(
+      match s with
+      | WEXITED n -> sprintf "exited with %d" n
+      | WSIGNALED n -> sprintf "was signaled: %d" n
+      | WSTOPPED n -> sprintf "was stopped: %d" n)
+
+  module Error = struct
+    type output = t
+    type t = [`Wrong_status of output * string]
+
+    let wrong_status (res : output) msgf =
+      ksprintf (fun msg -> fail (`Wrong_status (res, msg))) msgf
+
+    let pp fmt = function
+      | (`Wrong_status (res, msg) : [< t]) ->
+          Format.fprintf fmt "Process-error, wrong status: '%s': %s"
+            (status_to_string res#status)
+            msg
+
+    let fail_if_non_zero (res : output) msg =
+      if res#status <> Unix.WEXITED 0 then
+        wrong_status res "Non-zero exit status: %s" msg
+      else return ()
+  end
+end
+
+(** The state within this library is packed into an open object
+    (structural) type, this module just defines the [application_name]
+    method. *)
+module Base_state = struct
+  type base = < application_name: string >
+  type 'a t = 'a constraint 'a = < base ; .. >
+end
+
+(** Some {!Lwt_unix} functions. *)
+module System = struct let sleep f = Lwt_exception.catch Lwt_unix.sleep f
+end
+
+(** WIP [jq]-like manipulation in pure OCaml. *)
+module Jqo = struct
+  let of_string s = Ezjsonm.from_string s
+  let to_string j = Ezjsonm.(to_string (wrap j))
+
+  let field ~k = function
+    | `O l -> List.Assoc.find_exn l ~equal:String.equal k
+    | other -> ksprintf failwith "Jqo.field (%S) in %s" k (to_string other)
+
+  let list_find ~f = function
+    | `O l ->
+        List.find_map_exn ~f:(fun (_, j) -> if f j then Some j else None) l
+    | `A l -> List.find_exn ~f l
+    | other -> ksprintf failwith "Jqo.list_find in %s" (to_string other)
+
+  let list_exists ~f o =
+    match list_find o ~f with _ -> true | exception _ -> false
+
+  let remove_field o ~name =
+    match o with
+    | `O l -> `O (List.filter l ~f:(fun (k, _) -> k <> name))
+    | other ->
+        ksprintf failwith "Jqo.remove_field %S: No an object: %s" name
+          (to_string other)
+end
diff --git a/src/lib_network_sandbox/kiln.ml b/src/lib_network_sandbox/kiln.ml
new file mode 100644
index 000000000000..38c5ca5e3220
--- /dev/null
+++ b/src/lib_network_sandbox/kiln.ml
@@ -0,0 +1,119 @@
+open Internal_pervasives
+
+type t = {run: [`Docker of string]; port: int; postgres_port: int}
+
+let make ~run ~port ~postgres_port = {run; port; postgres_port}
+let default_docker_image = "obsidiansystems/tezos-bake-monitor:0.4.0"
+
+let default =
+  make ~run:(`Docker default_docker_image) ~port:8086 ~postgres_port:4_532
+
+let start ?(network_id = "zeronet") state
+    {run= `Docker image; port; postgres_port} ~node_uris ~bakers =
+  let name nonbase = sprintf "flxts-%s" nonbase in
+  let pg_password = Tezos_protocol.Key.Of_name.pubkey "pg-password" in
+  let pg_port = postgres_port in
+  let kiln_port = port in
+  let pg =
+    Running_processes.Process.docker_run (name "kiln-postgres-db")
+      ~image:"postgres"
+      ~options:
+        [ "-p"; sprintf "%d:5432" pg_port; "-e"
+        ; sprintf "POSTGRES_PASSWORD=%s" pg_password ]
+      ~args:[]
+  in
+  Running_processes.start state pg
+  >>= fun pg_process ->
+  Helpers.wait_for state ~attempts:20 ~seconds:8. (fun attempt ->
+      Running_processes.run_cmdf state
+        "docker run --rm -e PGPASSWORD=%s --network host -it postgres psql -h \
+         localhost -p %d -U postgres -w -c '\\l'"
+        pg_password pg_port
+      >>= fun res ->
+      Console.display_errors_of_command state res
+      >>= function
+      | true -> return (`Done ())
+      | false ->
+          return
+            (`Not_done
+              (sprintf "Waiting for postgres to be ready (%d)" attempt)) )
+  >>= fun () ->
+  (* We need to use /tmp and not the root-path because of Docker access rights. *)
+  let tmp = "/tmp" // sprintf "kiln-config-%d" port in
+  Running_processes.run_cmdf state
+    "rm -fr %s ; mkdir -p %s/config ; chmod -R 777 %s" tmp tmp tmp
+  >>= fun _ ->
+  Lwt_exception.catch
+    (fun () ->
+      Lwt_io.with_file ~perm:0o777 ~mode:Lwt_io.output (tmp // "config/loggers")
+        (fun out ->
+          Lwt_io.write out
+            {json|[
+{ "logger":{"Stderr":{}} , "filters": { "SQL":"Error" , "":"Info"}},
+{ "logger":{"File":{"file":"/var/run/bake-monitor/kiln.log"}}, "filters": { "": "Debug" } }
+]|json}
+      ) )
+    ()
+  >>= fun () ->
+  Running_processes.run_cmdf state " chmod -R 777 %s" tmp
+  >>= fun _ ->
+  let kiln =
+    Running_processes.Process.docker_run (name "kiln-backend") ~image
+      ~options:
+        ["--network"; "host"; "-v"; sprintf "%s:/var/run/bake-monitor" tmp]
+      ~args:
+        [ sprintf
+            "--pg-connection=host=localhost port=%d dbname=postgres \
+             user=postgres password=%s"
+            pg_port pg_password
+        ; "--nodes"
+        ; String.concat ~sep:"," node_uris
+        ; "--network"; network_id; "--"; "--port"; Int.to_string kiln_port ]
+  in
+  Running_processes.start state kiln
+  >>= fun kiln_process ->
+  Console.say state
+    EF.(
+      wf "Kiln was started with nodes: %s, and network-id: %s"
+        (List.map node_uris ~f:(sprintf "`%s`") |> String.concat ~sep:", ")
+        network_id)
+  >>= fun () ->
+  ( match bakers with
+  | [] -> return ()
+  | _ ->
+      Interactive_test.Pauser.generic state ~force:true
+        EF.
+          [ wf "Importing bakers in Kiln."
+          ; wf
+              "You should open <http://localhost:%d> and import the following \
+               bakers:"
+              kiln_port
+          ; list
+              (List.map bakers ~f:(fun (n, pkh) -> af "Baker: `%s` -> %s" n pkh))
+          ] )
+  >>= fun () -> return (pg_process, kiln_process)
+
+let cli_term () =
+  let open Cmdliner in
+  Term.(
+    pure (fun run port postgres_port -> function
+      | true -> Some (make ~run ~postgres_port ~port) | false -> None )
+    $ Arg.(
+        let doc = "Set the Kiln docker image." in
+        pure (fun docker_image -> `Docker docker_image)
+        $ value
+            (opt string default_docker_image (info ["kiln-docker-image"] ~doc)))
+    $ Arg.(
+        value
+          (opt int default.port (info ["kiln-port"] ~doc:"Set the kiln port.")))
+    $ Arg.(
+        value
+          (opt int default.postgres_port
+             (info ["kiln-pg-port"] ~doc:"Set the Postgres port for Kiln.")))
+    $ Arg.(
+        value
+          (flag
+             (info ["with-kiln"]
+                ~doc:
+                  "Add Kiln to the network (may make the test partially \
+                   interactive)."))))
diff --git a/src/lib_network_sandbox/kiln.mli b/src/lib_network_sandbox/kiln.mli
new file mode 100644
index 000000000000..d64cc29d8c7c
--- /dev/null
+++ b/src/lib_network_sandbox/kiln.mli
@@ -0,0 +1,38 @@
+(** Manage a Kiln process next to a network-sandbox. *)
+
+open Internal_pervasives
+
+type t
+
+val make : run:[`Docker of string] -> port:int -> postgres_port:int -> t
+(** Configure a Kiln process-to-be, running on port [~port] and
+    managing a PostgreSQL database on port [~postgres_port]. *)
+
+val default_docker_image : string
+val default : t
+
+val start :
+     ?network_id:string
+  -> < application_name: string
+     ; console: Console.t
+     ; paths: Paths.t
+     ; pauser: Interactive_test.Pauser.t
+     ; runner: Running_processes.State.t
+     ; test_interactivity: Interactive_test.Interactivity.t
+     ; .. >
+  -> t
+  -> node_uris:string list
+  -> bakers:(string * string) list
+  -> ( Running_processes.State.process_state
+       * Running_processes.State.process_state
+     , [> `Lwt_exn of exn | `Waiting_for of string * [`Time_out]] )
+     Asynchronous_result.t
+(** Start the Kiln and Postgres processes. [~network_id] is usually
+    the chain-id of the sandbox, [~node_uris] is the list or URIs given to
+    the ["--nodes"] option, if [~bakers] is not [[]] the test will force
+    [state#pauser] to pause for the user to add the baker addresses to
+    Kiln. *)
+
+val cli_term : unit -> t option Cmdliner.Term.t
+(** Build a {!Cmdliner.Term.t} which provides options like
+    ["--with-kiln"] or ["--kiln-docker-image"]. *)
diff --git a/src/lib_network_sandbox/log_recorder.ml b/src/lib_network_sandbox/log_recorder.ml
new file mode 100644
index 000000000000..2c8451a6a85a
--- /dev/null
+++ b/src/lib_network_sandbox/log_recorder.ml
@@ -0,0 +1,45 @@
+open Internal_pervasives
+
+module Operations = struct
+  (* This is likely a temporary module, which will be obsoleted by a
+     more general framework. *)
+  type t =
+    { mutable operations:
+        [ `Bake of string * string * string list
+        | `Endorse of string * string * string list
+        | `Transfer of string * string * string * string list ]
+        list }
+
+  let make () = {operations= []}
+  let from_state state : t = state#operations_log
+
+  let show_all state =
+    let t = from_state state in
+    Console.Prompt.unit_and_loop
+      EF.(af "Show all manual operations")
+      ["ao"; "all-ops"; "all-operations"]
+      (fun _ ->
+        Console.say state
+          EF.(
+            desc_list (haf "Operations:")
+              (List.rev_map t.operations ~f:(function
+                | `Transfer (cli, msg, dest, res) ->
+                    desc_list (haf "Transfer: %S" cli)
+                      [ af "→ %s" msg; af "dest: %s" dest
+                      ; ocaml_string_list res ]
+                | `Endorse (n, msg, res) ->
+                    desc_list
+                      (haf "Node-endorsed: %S" n)
+                      [af "→ %s" msg; ocaml_string_list res]
+                | `Bake (n, msg, res) ->
+                    desc_list (haf "Node-baked: %S" n)
+                      [af "→ %s" msg; ocaml_string_list res] ))) )
+
+  let bake state ~client ~output msg =
+    let t = from_state state in
+    t.operations <- `Bake (client, msg, output) :: t.operations
+
+  let endorse state ~client ~output msg =
+    let t = from_state state in
+    t.operations <- `Endorse (client, msg, output) :: t.operations
+end
diff --git a/src/lib_network_sandbox/paths.ml b/src/lib_network_sandbox/paths.ml
new file mode 100644
index 000000000000..65549f7efb17
--- /dev/null
+++ b/src/lib_network_sandbox/paths.ml
@@ -0,0 +1,18 @@
+open Internal_pervasives
+
+type t = {root: string}
+
+let make root = {root}
+let root_path o = o.root
+let pp fmt o = Format.fprintf fmt "@[<2>{Root:@ %s}@]" (root_path o)
+let ob o : t = o#paths
+let root o = ob o |> root_path
+
+let cli_term ?(option_name = "root-path") ~default_root () =
+  Cmdliner.(
+    Term.(
+      pure make
+      $ Arg.(
+          value & opt string default_root
+          & info [option_name]
+              ~doc:(sprintf "Root path for all configs/data to use."))))
diff --git a/src/lib_network_sandbox/paths.mli b/src/lib_network_sandbox/paths.mli
new file mode 100644
index 000000000000..4e4cc8aa8982
--- /dev/null
+++ b/src/lib_network_sandbox/paths.mli
@@ -0,0 +1,12 @@
+(** Configure and manipulate a “root-path.”   *)
+
+type t
+
+val make : string -> t
+val pp : Format.formatter -> t -> unit
+
+val root : < paths: t ; .. > -> string
+(** Query the configured root-path. *)
+
+val cli_term :
+  ?option_name:string -> default_root:string -> unit -> t Cmdliner.Term.t
diff --git a/src/lib_network_sandbox/running_processes.ml b/src/lib_network_sandbox/running_processes.ml
new file mode 100644
index 000000000000..34a9334a9096
--- /dev/null
+++ b/src/lib_network_sandbox/running_processes.ml
@@ -0,0 +1,259 @@
+open Internal_pervasives
+
+module Process = struct
+  type t =
+    { id: string
+    ; binary: string option
+    ; command: string list
+    ; kind: [`Process_group | `Docker of string] }
+
+  let make_in_session ?binary id command =
+    {id; binary; command= "setsid" :: command; kind= `Process_group}
+
+  let genspio id script =
+    let command = ["sh"; "-c"; Genspio.Compile.to_one_liner script] in
+    make_in_session id command
+
+  let docker_run id ~image ~options ~args =
+    let name = id in
+    let command =
+      ["docker"; "run"; "--name"; name; "--rm"] @ options @ [image] @ args
+    in
+    {id; binary= None; command; kind= `Docker name}
+end
+
+module State = struct
+  type process_state = {process: Process.t; lwt: Lwt_process.process_none}
+  type t = {processes: (string, process_state) Hashtbl.t}
+
+  let pp fmt {processes} =
+    let open Format in
+    fprintf fmt "Processes:@ [@[" ;
+    Hashtbl.iter (fun s {lwt; _} -> fprintf fmt "%S:%d" s lwt#pid) processes ;
+    fprintf fmt "]@]"
+
+  let make () = {processes= Hashtbl.create 42}
+  let processes o = (o#runner : t).processes
+
+  let add_process o process lwt =
+    Hashtbl.add (processes o) process.Process.id {process; lwt} ;
+    return ()
+
+  let all_processes t =
+    let res = ref [] in
+    Hashtbl.iter (fun _ t -> res := t :: !res) (processes t) ;
+    return !res
+end
+
+open State
+open Process
+
+let output_path t process which =
+  let sanitize =
+    String.map ~f:(function '\'' | '/' | '"' -> '_' | other -> other)
+  in
+  Paths.root t
+  // ( "output"
+     // sanitize process.Process.id
+     //
+     match which with
+     | `Stdout -> "stdout.log"
+     | `Stderr -> "stderr.log"
+     | `Meta -> "meta.log" )
+
+let ef_procesess state processes =
+  EF.(
+    desc_list (af "Processes")
+      (List.map processes ~f:(fun {process; lwt} ->
+           desc_list (af "P:%s" process.id)
+             [ desc (af "out") (atom (output_path state process `Stdout))
+             ; desc (af "err") (atom (output_path state process `Stderr))
+             ; desc (af "pid") (af "%d" lwt#pid) ] )))
+
+let unix_status_to_string (p : Unix.process_status) =
+  match p with
+  | Unix.WEXITED i -> sprintf "exited:%d" i
+  | Unix.WSIGNALED i -> sprintf "signaled:%d" i
+  | Unix.WSTOPPED i -> sprintf "stopped:%d" i
+
+let ef_lwt_state =
+  let open Lwt_process in
+  function
+  | Running -> EF.af "Running" | Exited p -> EF.atom (unix_status_to_string p)
+
+let ef ?(all = false) state =
+  EF.(
+    let all_procs =
+      Hashtbl.fold
+        (fun _ {process; lwt} prev ->
+          match (all, lwt#state) with
+          | true, _ | false, Lwt_process.Running ->
+              ( process.id
+              , list ~delimiters:("{", "}")
+                  [ haf "%s:" process.id
+                  ; desc (af "pid:") (af "%d" lwt#pid)
+                  ; desc (af "state:") (ef_lwt_state lwt#state)
+                  ; desc (af "kind:")
+                      ( match process.kind with
+                      | `Docker n -> af "docker:%s" n
+                      | `Process_group -> af "process-group" ) ] )
+              :: prev
+          | _, _ -> prev )
+        (State.processes state) []
+      |> List.sort ~compare:(fun (a, _) (b, _) -> String.compare a b)
+      |> List.map ~f:snd
+    in
+    label (af "Processes:") (list all_procs))
+
+let start t process =
+  let date = Tezos_base.Time.(now () |> to_notation) in
+  let open_file f =
+    Lwt_exception.catch ~attach:[("open_file", f)]
+      Lwt.Infix.(
+        fun () ->
+          Tezos_stdlib_unix.Lwt_utils_unix.create_dir ~perm:0o700
+            (Filename.dirname f)
+          >>= fun () ->
+          Lwt_unix.file_exists f
+          >>= fun exists ->
+          ( if exists then Lwt_unix.rename f (sprintf "%s.saved-%s" f date)
+          else Lwt.return () )
+          >>= fun () ->
+          Lwt_unix.(
+            openfile f [O_CREAT; O_WRONLY; O_APPEND] 0o600 >|= unix_file_descr))
+      ()
+  in
+  open_file (output_path t process `Stdout)
+  >>= fun stdout ->
+  open_file (output_path t process `Stderr)
+  >>= fun stderr ->
+  Lwt_exception.catch
+    (fun () ->
+      Lwt_io.with_file ~mode:Lwt_io.output
+        ~flags:Unix.[O_CREAT; O_WRONLY; O_APPEND]
+        (output_path t process `Meta)
+        (fun chan ->
+          let msg =
+            let sep = String.make 80 '=' in
+            sprintf "\n%s\nDate: %s\nStarting: %s\nCmd: [%s]\n%s\n" sep date
+              process.Process.id
+              ( List.map process.command ~f:(sprintf "%S")
+              |> String.concat ~sep:"; " )
+              sep
+          in
+          Lwt_io.write chan msg ) )
+    ()
+  >>= fun () ->
+  let proc =
+    Lwt_process.open_process_none ~stdout:(`FD_move stdout)
+      ~stderr:(`FD_move stderr)
+      (Option.value ~default:"" process.binary, Array.of_list process.command)
+  in
+  State.add_process t process proc >>= fun () -> return {process; lwt= proc}
+
+let wait _t {lwt; _} =
+  Lwt_exception.catch (fun () -> lwt#close) ()
+  >>= fun _status -> return _status
+
+let kill _t {lwt; process} =
+  match process.kind with
+  | `Process_group ->
+      Lwt_exception.catch
+        (fun () ->
+          let signal = Sys.sigterm in
+          let pid = ~-(lwt#pid) (* Assumes “in session” *) in
+          ( try Unix.kill pid signal with
+          | Unix.Unix_error (Unix.ESRCH, _, _) -> ()
+          | e -> raise e ) ;
+          Lwt.return () )
+        ()
+  | `Docker name -> (
+      Lwt_exception.catch Lwt_unix.system (sprintf "docker kill %s" name)
+      >>= fun status ->
+      match status with
+      | Lwt_unix.WEXITED 0 -> return ()
+      | other ->
+          (* Likely already dead *)
+          Dbg.e
+            EF.(
+              desc
+                (shout "docker kill failed")
+                (list
+                   [ af "docker-container: %s" name
+                   ; af "status: %s" (unix_status_to_string other) ])) ;
+          return () )
+
+let wait_all t =
+  State.all_processes t
+  >>= fun all ->
+  List.fold all ~init:(return ()) ~f:(fun prevm one ->
+      prevm >>= fun () -> wait t one >>= fun _ -> return () )
+
+let kill_all t =
+  State.all_processes t
+  >>= fun all ->
+  List.fold all ~init:(return ()) ~f:(fun prevm one ->
+      prevm >>= fun () -> kill t one )
+
+let find_process_by_id ?(only_running = false) t ~f =
+  State.all_processes t
+  >>= fun all ->
+  return
+    (List.filter all ~f:(fun {process= {id; _}; lwt} ->
+         if only_running && not (lwt#state = Lwt_process.Running) then false
+         else f id ))
+
+let cmds = ref 0
+
+let fresh_id _state prefix ~seed =
+  incr cmds ;
+  sprintf "%s-%05d-%s-%08d" prefix !cmds
+    Digest.(string seed |> to_hex)
+    Random.(int 10_000_000)
+
+let run_cmdf state fmt =
+  let get_file path =
+    Lwt_exception.catch
+      Lwt.Infix.(
+        fun () ->
+          Lwt_io.open_file ~mode:Lwt_io.input path
+          >>= fun inchan ->
+          let stream = Lwt_io.read_lines inchan in
+          Lwt_stream.to_list stream)
+      ()
+  in
+  ksprintf
+    (fun s ->
+      let id = fresh_id state "cmd" ~seed:s in
+      let proc = Process.make_in_session id ["sh"; "-c"; s] in
+      start state proc
+      >>= fun proc ->
+      wait state proc
+      >>= fun status ->
+      get_file (output_path state proc.process `Stdout)
+      >>= fun out_lines ->
+      get_file (output_path state proc.process `Stderr)
+      >>= fun err_lines ->
+      return
+        (object
+           method out = out_lines
+
+           method err = err_lines
+
+           method status = status
+        end) )
+    fmt
+
+let run_successful_cmdf state fmt =
+  ksprintf
+    (fun cmd ->
+      run_cmdf state "%s" cmd
+      >>= fun res ->
+      Process_result.Error.fail_if_non_zero res
+        (sprintf "Shell command: %S" cmd)
+      >>= fun () -> return res )
+    fmt
+
+let run_genspio state name genspio =
+  let proc = Process.genspio (fresh_id state name ~seed:name) genspio in
+  start state proc >>= fun proc -> wait state proc
diff --git a/src/lib_network_sandbox/running_processes.mli b/src/lib_network_sandbox/running_processes.mli
new file mode 100644
index 000000000000..48a6b6897b13
--- /dev/null
+++ b/src/lib_network_sandbox/running_processes.mli
@@ -0,0 +1,97 @@
+(** Run and monitor processes. *)
+
+open Internal_pervasives
+
+(** The definition of a process, for now, a process within a
+    process-group or a Docker container. *)
+module Process : sig
+  type t = private
+    { id: string
+    ; binary: string option
+    ; command: string list
+    ; kind: [`Process_group | `Docker of string] }
+
+  val make_in_session : ?binary:string -> string -> string list -> t
+  val genspio : string -> 'a Genspio.EDSL.t -> t
+
+  val docker_run :
+    string -> image:string -> options:string list -> args:string list -> t
+end
+
+(** The container for a list of running or not processes. *)
+module State : sig
+  type process_state = private
+    {process: Process.t; lwt: Lwt_process.process_none}
+
+  type t = private {processes: (string, process_state) Hashtbl.t}
+
+  val pp : Format.formatter -> t -> unit
+  val make : unit -> t
+end
+
+val output_path :
+     < paths: Paths.t ; .. >
+  -> Process.t
+  -> [ `Meta | `Stderr | `Stdout]
+  -> string
+(** Return the path (within {!Paths}'s root-path) where the process
+    writes its output or metadata. *)
+
+val ef_procesess :
+  < paths: Paths.t ; .. > -> State.process_state list -> Easy_format.t
+
+val ef : ?all:bool -> < runner: State.t ; .. > -> Easy_format.t
+
+val start :
+     < paths: Paths.t ; runner: State.t ; .. >
+  -> Process.t
+  -> (State.process_state, [> `Lwt_exn of exn]) Asynchronous_result.t
+
+val wait :
+     < runner: State.t ; .. >
+  -> State.process_state
+  -> (Lwt_unix.process_status, [> `Lwt_exn of exn]) Asynchronous_result.t
+
+val kill :
+     < runner: State.t ; .. >
+  -> State.process_state
+  -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+
+val wait_all :
+  < runner: State.t ; .. > -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+
+val kill_all :
+  < runner: State.t ; .. > -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+
+val find_process_by_id :
+     ?only_running:bool
+  -> < runner: State.t ; .. >
+  -> f:(string -> bool)
+  -> (State.process_state list, [> ]) Asynchronous_result.t
+
+val run_cmdf :
+     < paths: Paths.t ; runner: State.t ; .. >
+  -> ( 'a
+     , unit
+     , string
+     , (Process_result.t, [> `Lwt_exn of exn]) Asynchronous_result.t )
+     format4
+  -> 'a
+(** Run a shell command and wait for its end. *)
+
+val run_successful_cmdf :
+     < paths: Paths.t ; runner: State.t ; .. >
+  -> ( 'a
+     , unit
+     , string
+     , ( Process_result.t
+       , [> `Lwt_exn of exn | Process_result.Error.t] )
+       Asynchronous_result.t )
+     format4
+  -> 'a
+
+val run_genspio :
+     < paths: Paths.t ; runner: State.t ; .. >
+  -> string
+  -> 'a Genspio.Language.t
+  -> (Lwt_unix.process_status, [> `Lwt_exn of exn]) Asynchronous_result.t
diff --git a/src/lib_network_sandbox/test_command_line.ml b/src/lib_network_sandbox/test_command_line.ml
new file mode 100644
index 000000000000..7c985b564681
--- /dev/null
+++ b/src/lib_network_sandbox/test_command_line.ml
@@ -0,0 +1,51 @@
+open Internal_pervasives
+
+module Run_command = struct
+  let or_hard_fail state main ~pp_error : unit =
+    let open Asynchronous_result in
+    run_application (fun () ->
+        bind_on_error (main ()) ~f:(fun e ->
+            transform_error
+              ~f:(fun (`Lwt_exn _) _ -> die 3)
+              (Console.say state
+                 EF.(custom (fun fmt -> (Error.pp ~error:pp_error) fmt e)))
+            >>= fun () -> die 2 ) )
+
+  let term ~pp_error () =
+    Cmdliner.Term.pure (fun (state, run) -> or_hard_fail state run ~pp_error)
+
+  let make ~pp_error t i = Cmdliner.Term.(term ~pp_error () $ t, i)
+end
+
+let cli_state ?default_interactivity ?(disable_interactivity = false) ~name ()
+    =
+  let runner = Running_processes.State.make () in
+  let default_root = sprintf "/tmp/%s-test" name in
+  let app = sprintf "Flextesa.%s" name in
+  let pauser = Interactive_test.Pauser.make [] in
+  let ops = Log_recorder.Operations.make () in
+  let state console paths interactivity =
+    object
+      method paths = paths
+
+      method runner = runner
+
+      method console = console
+
+      method application_name = app
+
+      method test_interactivity = interactivity
+
+      method pauser = pauser
+
+      method operations_log = ops
+    end
+  in
+  let open Cmdliner in
+  Term.(
+    pure state $ Console.cli_term ()
+    $ Paths.cli_term ~default_root ()
+    $
+    if disable_interactivity then pure `None
+    else
+      Interactive_test.Interactivity.cli_term ?default:default_interactivity ())
diff --git a/src/lib_network_sandbox/test_command_line.mli b/src/lib_network_sandbox/test_command_line.mli
new file mode 100644
index 000000000000..f6961981d99d
--- /dev/null
+++ b/src/lib_network_sandbox/test_command_line.mli
@@ -0,0 +1,29 @@
+(** Functions for building test-scenarios commands. *)
+
+open Internal_pervasives
+
+(** Make {!Cmdliner} commands from {!Asynchronous_result} functions. *)
+module Run_command : sig
+  val make :
+       pp_error:(Format.formatter -> ([> ] as 'a) -> unit)
+    -> ( < application_name: string ; console: Console.t ; .. >
+       * (unit -> (unit, 'a) Asynchronous_result.t) )
+       Cmdliner.Term.t
+    -> 'b
+    -> unit Cmdliner.Term.t * 'b
+end
+
+val cli_state :
+     ?default_interactivity:Interactive_test.Interactivity.t
+  -> ?disable_interactivity:bool
+  -> name:string
+  -> unit
+  -> < application_name: string
+     ; console: Console.t
+     ; operations_log: Log_recorder.Operations.t
+     ; paths: Paths.t
+     ; pauser: Interactive_test.Pauser.t
+     ; runner: Running_processes.State.t
+     ; test_interactivity: Interactive_test.Interactivity.t >
+     Cmdliner.Term.t
+(** Create a full [state] value for test-scenarios. *)
diff --git a/src/lib_network_sandbox/test_scenario.ml b/src/lib_network_sandbox/test_scenario.ml
new file mode 100644
index 000000000000..817e5c9fd0c3
--- /dev/null
+++ b/src/lib_network_sandbox/test_scenario.ml
@@ -0,0 +1,325 @@
+open Internal_pervasives
+
+module Inconsistency_error = struct
+  type t = [`Empty_protocol_list | `Too_many_protocols of Tezos_protocol.t list]
+
+  let should_be_one_protocol = function
+    | [one] -> return one
+    | [] -> fail `Empty_protocol_list
+    | more -> fail (`Too_many_protocols more)
+
+  let pp fmt err =
+    Format.fprintf fmt "Wrong number of protocols in network: %d"
+      ( match err with
+      | `Empty_protocol_list -> 0
+      | `Too_many_protocols p -> List.length p )
+end
+
+module Topology = struct
+  type node = Tezos_node.t
+
+  type _ t =
+    | Mesh : {size: int} -> node list t
+    | Bottleneck :
+        { name: string
+        ; left: 'a network
+        ; right: 'b network }
+        -> ('a * node * 'b) t
+    | Net_in_the_middle :
+        { middle: 'm network
+        ; left: 'a network
+        ; right: 'b network }
+        -> ('a * 'm * 'b) t
+
+  and 'a network = {topology: 'a t; name: string}
+
+  let make name topology = {name; topology}
+  let mesh name size = Mesh {size} |> make name
+  let sub = make
+  let bottleneck name left right = Bottleneck {name; left; right} |> make name
+
+  let net_in_the_middle name middle left right =
+    Net_in_the_middle {middle; left; right} |> make name
+
+  let rec node_count : type a. a t -> int = function
+    | Mesh {size} -> size
+    | Bottleneck {left; right; _} ->
+        1 + node_count left.topology + node_count right.topology
+    | Net_in_the_middle {left; right; middle} ->
+        node_count middle.topology + node_count left.topology
+        + node_count right.topology
+
+  let rec node_ids : type a. a t -> a -> string list =
+   fun topo res ->
+    match (topo, res) with
+    | Mesh _, l -> List.map l ~f:(fun nod -> nod.Tezos_node.id)
+    | Bottleneck {left; right; _}, (l, i, r) ->
+        (i.Tezos_node.id :: node_ids left.topology l)
+        @ node_ids right.topology r
+    | Net_in_the_middle {left; right; middle}, (l, i, r) ->
+        node_ids middle.topology i @ node_ids left.topology l
+        @ node_ids right.topology r
+
+  let rec node_names : type a. ?prefix:string -> a network -> string list =
+   fun ?(prefix = "") {name; topology} ->
+    let make_ith i = sprintf "%s%03d" prefix i in
+    let continue a = node_names ~prefix:(prefix ^ name) a in
+    match topology with
+    | Mesh {size} -> List.init size ~f:make_ith
+    | Bottleneck {name; left; right} ->
+        (sprintf "%s%s" prefix name :: continue left) @ continue right
+    | Net_in_the_middle {left; right; middle} ->
+        continue middle @ continue left @ continue right
+
+  let build ?protocol ?(base_port = 15_001) ~exec network =
+    let all_ports = ref [] in
+    let next_port = ref (base_port + (base_port mod 2)) in
+    let rpc name =
+      match List.find !all_ports ~f:(fun (n, _) -> n = name) with
+      | Some (_, p) -> p
+      | None ->
+          let p = !next_port in
+          all_ports := (name, p) :: !all_ports ;
+          next_port := !next_port + 2 ;
+          p
+    in
+    let p2p n = rpc n + 1 in
+    let node peers id =
+      let rpc_port = rpc id in
+      let p2p_port = p2p id in
+      let expected_connections = List.length peers in
+      let peers =
+        List.filter_map peers ~f:(fun p ->
+            if p <> id then Some (p2p p) else None )
+      in
+      Tezos_node.make ?protocol ~exec id ~expected_connections ~rpc_port
+        ~p2p_port peers
+    in
+    let dbgp prefx names =
+      Printf.eprintf "%s:\n  %s\n%!" prefx
+        (String.concat ~sep:"\n  "
+           (List.map names ~f:(fun n -> sprintf "%s:%d" n (p2p n))))
+    in
+    let rec make : type a.
+        ?extra_peers:string list -> prefix:string -> a network -> a =
+     fun ?(extra_peers = []) ~prefix network ->
+      let prefix = prefix ^ network.name in
+      let make ?extra_peers n = make ?extra_peers ~prefix n in
+      match network.topology with
+      | Bottleneck {name; left; right} ->
+          let intermediate = name in
+          let extra_peers = [intermediate] in
+          let left_nodes = make ~extra_peers left in
+          let right_nodes = make ~extra_peers right in
+          let intermediate_node =
+            let peers =
+              node_ids left.topology left_nodes
+              @ node_ids right.topology right_nodes
+            in
+            node peers intermediate
+          in
+          (left_nodes, intermediate_node, right_nodes)
+      | Net_in_the_middle {middle; left; right} ->
+          let middle_names =
+            node_names ~prefix:(prefix ^ middle.name) middle
+          in
+          dbgp "Mid-name" middle_names ;
+          let left_nodes =
+            make ~extra_peers:(extra_peers @ middle_names) left
+          in
+          let right_nodes =
+            make ~extra_peers:(extra_peers @ middle_names) right
+          in
+          let intermediate_nodes =
+            let peers =
+              node_ids left.topology left_nodes
+              @ node_ids right.topology right_nodes
+            in
+            dbgp "peers" peers ;
+            dbgp "extr-peers" extra_peers ;
+            dbgp "left-names" (node_names ~prefix:(prefix ^ left.name) left) ;
+            dbgp "right-names" (node_names ~prefix:(prefix ^ right.name) right) ;
+            make ~extra_peers:(peers @ extra_peers) middle
+          in
+          (left_nodes, intermediate_nodes, right_nodes)
+      | Mesh _ ->
+          let all = node_names ~prefix network in
+          dbgp "mesh-names" all ;
+          let nodes = List.map all ~f:(fun n -> node (all @ extra_peers) n) in
+          nodes
+    in
+    make ~prefix:"" network
+end
+
+module Network = struct
+  type t = {nodes: Tezos_node.t list}
+
+  let make nodes = {nodes}
+
+  let netstat state =
+    Running_processes.run_cmdf state "netstat -nut"
+    >>= fun res ->
+    Process_result.Error.fail_if_non_zero res "netstat -nut command"
+    >>= fun () ->
+    let rows =
+      List.filter_mapi res#out ~f:(fun idx line ->
+          match
+            String.split line ~on:' '
+            |> List.filter_map ~f:(fun s ->
+                   match String.strip s with "" -> None | s -> Some s )
+          with
+          | ("tcp" | "tcp6") :: _ as row -> Some (`Tcp (idx, row))
+          | _ -> Some (`Wrong (idx, line)) )
+    in
+    return rows
+
+  let all_listening_ports rows =
+    List.filter_map rows ~f:(function
+      | `Tcp (_, _ :: _ :: _ :: addr :: _) as row -> (
+        match String.split addr ~on:':' with
+        | [_; port] -> ( try Some (Int.of_string port, row) with _ -> None )
+        | _ -> None )
+      | _ -> None )
+
+  let netstat_listening_ports state =
+    netstat state
+    >>= fun rows ->
+    let all_used = all_listening_ports rows in
+    return all_used
+
+  let start_up ?(check_ports = true) state ~client_exec {nodes} =
+    ( if check_ports then
+      netstat_listening_ports state
+      >>= fun all_used ->
+      let taken port =
+        List.find all_used ~f:(fun (p, _) -> Int.equal p port)
+      in
+      List_sequential.iter nodes
+        ~f:(fun {Tezos_node.id; rpc_port; p2p_port; _} ->
+          let fail s (p, `Tcp (_, row)) =
+            System_error.fail "Node: %S's %s port %d already in use {%s}" id s
+              p
+              (String.concat ~sep:"|" row)
+          in
+          let time_wait (_, `Tcp (_, row)) =
+            List.last row = Some "TIME_WAIT"
+          in
+          match (taken rpc_port, taken p2p_port) with
+          | None, None -> return ()
+          | Some p, _ -> if time_wait p then return () else fail "RPC" p
+          | _, Some p -> if time_wait p then return () else fail "P2P" p )
+    else return () )
+    >>= fun () ->
+    let protocols =
+      List.map ~f:Tezos_node.protocol nodes
+      |> List.dedup_and_sort ~compare:Tezos_protocol.compare
+    in
+    Inconsistency_error.should_be_one_protocol protocols
+    >>= fun protocol ->
+    Tezos_protocol.ensure protocol ~config:state
+    >>= fun () ->
+    List.fold nodes ~init:(return ()) ~f:(fun prev_m node ->
+        prev_m
+        >>= fun () ->
+        Running_processes.start state (Tezos_node.process state node)
+        >>= fun _ -> return () )
+    >>= fun () ->
+    let node_0 = List.hd_exn nodes in
+    let client = Tezos_client.of_node node_0 ~exec:client_exec in
+    Dbg.e EF.(af "Trying to bootstrap client") ;
+    Tezos_client.bootstrapped client ~state
+    >>= fun () ->
+    Tezos_client.activate_protocol client ~state protocol
+    >>= fun () ->
+    Dbg.e EF.(af "Waiting for all nodes to be bootstrapped") ;
+    List_sequential.iter nodes ~f:(fun node ->
+        let client = Tezos_client.of_node node ~exec:client_exec in
+        Tezos_client.bootstrapped client ~state )
+end
+
+let network_with_protocol ?base_port ?(size = 5) ?protocol state ~node_exec
+    ~client_exec =
+  let nodes =
+    Topology.build ?base_port ?protocol ~exec:node_exec
+      (Topology.mesh "N" size)
+  in
+  let protocols =
+    List.map ~f:Tezos_node.protocol nodes
+    |> List.dedup_and_sort ~compare:Tezos_protocol.compare
+  in
+  Inconsistency_error.should_be_one_protocol protocols
+  >>= fun protocol ->
+  Network.start_up state ~client_exec (Network.make nodes)
+  >>= fun () -> return (nodes, protocol)
+
+module Queries = struct
+  let all_levels state ~nodes =
+    List.fold nodes ~init:(return [])
+      ~f:(fun prevm {Tezos_node.id; rpc_port; _} ->
+        prevm
+        >>= fun prev ->
+        Running_processes.run_cmdf state
+          "curl http://localhost:%d/chains/main/blocks/head/metadata | jq \
+           .level.level"
+          rpc_port
+        >>= fun lvl ->
+        Console.display_errors_of_command state lvl ~should_output:true
+        >>= function
+        | true ->
+            let res = String.concat ~sep:"\n" lvl#out in
+            let parsed =
+              match Int.of_string res with
+              | i -> `Level i
+              | exception _ -> (
+                match res with "null" -> `Null | unknown -> `Unknown unknown )
+            in
+            return ((id, parsed) :: prev)
+        | false -> return ((id, `Failed) :: prev) )
+    >>= fun results ->
+    let sorted =
+      List.sort results ~compare:(fun (a, _) (b, _) -> String.compare a b)
+    in
+    return sorted
+
+  let wait_for_all_levels_to_be state ~attempts ~seconds nodes level =
+    let check_level =
+      match level with
+      | `Equal_to l -> ( = ) l
+      | `At_least l -> fun x -> x >= l
+    in
+    let level_string =
+      match level with
+      | `Equal_to l -> sprintf "= %d" l
+      | `At_least l -> sprintf "≥ %d" l
+    in
+    let msg ids =
+      let show_node (id, res) =
+        sprintf "%s (%s)" id
+          ( match res with
+          | `Failed -> "failed"
+          | `Level l -> sprintf "%d" l
+          | `Null -> "null"
+          | `Unknown s -> sprintf "¿¿ %S ??" s )
+      in
+      sprintf "Waiting for %s to reach level %s"
+        (String.concat (List.map ~f:show_node ids) ~sep:", ")
+        level_string
+    in
+    Console.say state
+      EF.(
+        wf "Checking for all levels to be %s (nodes: %s)" level_string
+          (String.concat ~sep:", "
+             (List.map nodes ~f:(fun n -> n.Tezos_node.id))))
+    >>= fun () ->
+    Helpers.wait_for state ~attempts ~seconds (fun _nth ->
+        all_levels state ~nodes
+        >>= fun results ->
+        let not_readys =
+          List.filter_map results ~f:(function
+            | _, `Level n when check_level n -> None
+            | id, res -> Some (id, res) )
+        in
+        match not_readys with
+        | [] -> return (`Done ())
+        | ids -> return (`Not_done (msg ids)) )
+end
diff --git a/src/lib_network_sandbox/test_scenario.mli b/src/lib_network_sandbox/test_scenario.mli
new file mode 100644
index 000000000000..1cc7fbd8383e
--- /dev/null
+++ b/src/lib_network_sandbox/test_scenario.mli
@@ -0,0 +1,134 @@
+(** Build and manage Network Sandboxes. *)
+
+open Internal_pervasives
+
+module Inconsistency_error : sig
+  type t = [`Empty_protocol_list | `Too_many_protocols of Tezos_protocol.t list]
+
+  val should_be_one_protocol :
+       'a list
+    -> ( 'a
+       , [> `Empty_protocol_list | `Too_many_protocols of 'a list] Error.t )
+       result
+       Lwt.t
+
+  val pp :
+       Format.formatter
+    -> [< `Empty_protocol_list | `Too_many_protocols of 'a Base.List.t]
+    -> unit
+end
+
+(** Build {i static} tezos network topologies. *)
+module Topology : sig
+  type node = Tezos_node.t
+
+  type _ t = private
+    | Mesh : {size: int} -> node list t
+    | Bottleneck :
+        { name: string
+        ; left: 'a network
+        ; right: 'b network }
+        -> ('a * node * 'b) t
+    | Net_in_the_middle :
+        { middle: 'm network
+        ; left: 'a network
+        ; right: 'b network }
+        -> ('a * 'm * 'b) t
+
+  and 'a network = {topology: 'a t; name: string}
+
+  val mesh : string -> int -> node list network
+  val sub : string -> 'a t -> 'a network
+
+  val bottleneck :
+    string -> 'a network -> 'b network -> ('a * node * 'b) network
+
+  val node_count : 'a t -> int
+  val node_ids : 'a t -> 'a -> string list
+
+  val net_in_the_middle :
+    string -> 'a network -> 'b network -> 'c network -> ('b * 'a * 'c) network
+
+  val build :
+       ?protocol:Tezos_protocol.t
+    -> ?base_port:int
+    -> exec:[`Node] Tezos_executable.t
+    -> 'a network
+    -> 'a
+end
+
+(** Start networks from (and manipulate) {!Topology.t} values. *)
+module Network : sig
+  type t = private {nodes: Tezos_node.t list}
+
+  val make : Tezos_node.t list -> t
+
+  val netstat_listening_ports :
+       < paths: Paths.t ; runner: Running_processes.State.t ; .. >
+    -> ( (int * [> `Tcp of int * string list]) list
+       , [> `Lwt_exn of exn | Process_result.Error.t] )
+       Asynchronous_result.t
+  (** Call ["netstat"] to find TCP ports already in use. *)
+
+  val start_up :
+       ?check_ports:bool
+    -> < paths: Paths.t ; runner: Running_processes.State.t ; .. >
+    -> client_exec:[`Client] Tezos_executable.t
+    -> t
+    -> ( unit
+       , [> `Empty_protocol_list
+         | `Lwt_exn of exn
+         | `Sys_error of string
+         | Process_result.Error.t
+         | `Too_many_protocols of Tezos_protocol.t list ] )
+       Asynchronous_result.t
+end
+
+val network_with_protocol :
+     ?base_port:int
+  -> ?size:int
+  -> ?protocol:Tezos_protocol.t
+  -> < paths: Paths.t ; runner: Running_processes.State.t ; .. >
+  -> node_exec:[`Node] Tezos_executable.t
+  -> client_exec:[`Client] Tezos_executable.t
+  -> ( Tezos_node.t list * Tezos_protocol.t
+     , [> `Empty_protocol_list
+       | `Lwt_exn of exn
+       | `Sys_error of string
+       | Process_result.Error.t
+       | `Too_many_protocols of Tezos_protocol.t list ] )
+     Asynchronous_result.t
+(** [network_with_protocol] is a wrapper simply starting-up a
+    {!Topology.mesh}. *)
+
+(** Run queries on running networks. *)
+module Queries : sig
+  val all_levels :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> nodes:Tezos_node.t list
+    -> ( (string * [> `Failed | `Level of int | `Null | `Unknown of string])
+         list
+       , [> `Lwt_exn of exn] )
+       Asynchronous_result.t
+  (** Get the current chain level for all the nodes, returns {i
+      node-ID × level } values. *)
+
+  val wait_for_all_levels_to_be :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> attempts:int
+    -> seconds:float
+    -> Tezos_node.t list
+    -> [< `At_least of int | `Equal_to of int]
+    -> ( unit
+       , [> `Lwt_exn of exn | `Waiting_for of string * [`Time_out]] )
+       Asynchronous_result.t
+  (** Try-sleep-loop waiting for all given nodes to reach a given level. *)
+end
diff --git a/src/lib_network_sandbox/tezos-network-sandbox.opam b/src/lib_network_sandbox/tezos-network-sandbox.opam
new file mode 100644
index 000000000000..697da5f5e3d0
--- /dev/null
+++ b/src/lib_network_sandbox/tezos-network-sandbox.opam
@@ -0,0 +1,25 @@
+opam-version: "2.0"
+version: "dev"
+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" }
+  "genspio" { = "0.0.2" }
+  "dum"
+  "tezos-stdlib-unix"
+  "tezos-signer-backends"
+  "tezos-client-alpha"
+  "lwt"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
+synopsis: "Tezos: library to manage network sandboxes"
diff --git a/src/lib_network_sandbox/tezos_admin_client.ml b/src/lib_network_sandbox/tezos_admin_client.ml
new file mode 100644
index 000000000000..7c7154d8b758
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_admin_client.ml
@@ -0,0 +1,47 @@
+open Internal_pervasives
+
+type t = {id: string; port: int; exec: [`Admin] Tezos_executable.t}
+
+let base_dir t ~state = Paths.root state // sprintf "Admin-client-base-%s" t.id
+
+let of_client ~exec n =
+  let id = sprintf "A-%s" n.Tezos_client.id in
+  let port = n.Tezos_client.port in
+  {id; port; exec}
+
+let of_node ~exec n =
+  let id = sprintf "C-%s" n.Tezos_node.id in
+  let port = n.Tezos_node.rpc_port in
+  {id; port; exec}
+
+let make_command t state args =
+  let open Tezos_executable.Make_cli in
+  Tezos_executable.call t.exec
+    ~path:(base_dir t ~state // "exec-admin")
+    (optf "port" "%d" t.port @ opt "base-dir" (base_dir ~state t) @ args)
+
+module Command_error = struct
+  type t = [`Admin_command_error of string * string list option]
+
+  let failf ?args fmt =
+    ksprintf (fun s -> fail (`Admin_command_error (s, args) : [> t])) fmt
+
+  let pp fmt (`Admin_command_error (msg, args) : t) =
+    Format.fprintf fmt "Admin-command-error:@ %s%s" msg
+      (Option.value_map args ~default:"" ~f:(fun l ->
+           sprintf " (args: %s)"
+             (List.map ~f:(sprintf "%S") l |> String.concat ~sep:", ") ))
+end
+
+open Command_error
+
+let successful_command admin state args =
+  Running_processes.run_cmdf state "sh -c %s"
+    ( make_command admin state args
+    |> Genspio.Compile.to_one_liner |> Filename.quote )
+  >>= fun res ->
+  Console.display_errors_of_command state res
+  >>= function
+  | true -> return res
+  | false ->
+      failf ~args "Admin-command failure: %s" (String.concat ~sep:" " args)
diff --git a/src/lib_network_sandbox/tezos_admin_client.mli b/src/lib_network_sandbox/tezos_admin_client.mli
new file mode 100644
index 000000000000..b5bd1f32310f
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_admin_client.mli
@@ -0,0 +1,35 @@
+(** Wrapper around the [tezos-admin-client] application. *)
+open Internal_pervasives
+
+(** [t] is very similar to {!Tezos_client.t}. *)
+type t = private {id: string; port: int; exec: [`Admin] Tezos_executable.t}
+
+val of_client : exec:[`Admin] Tezos_executable.t -> Tezos_client.t -> t
+val of_node : exec:[`Admin] Tezos_executable.t -> Tezos_node.t -> t
+
+val make_command :
+  t -> < paths: Paths.t ; .. > -> string list -> unit Genspio.EDSL.t
+(** Build a [Genspio.EDSL.t] command. *)
+
+module Command_error : sig
+  type t = [`Admin_command_error of string * string list option]
+
+  val failf :
+       ?args:string list
+    -> ('a, unit, string, ('b, [> t]) Asynchronous_result.t) format4
+    -> 'a
+
+  val pp : Format.formatter -> t -> unit
+end
+
+val successful_command :
+     t
+  -> < application_name: string
+     ; console: Console.t
+     ; paths: Paths.t
+     ; runner: Running_processes.State.t
+     ; .. >
+  -> string list
+  -> ( Process_result.t
+     , [> Command_error.t | `Lwt_exn of exn] )
+     Asynchronous_result.t
diff --git a/src/lib_network_sandbox/tezos_client.ml b/src/lib_network_sandbox/tezos_client.ml
new file mode 100644
index 000000000000..c1a8a8940ae3
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_client.ml
@@ -0,0 +1,276 @@
+open Internal_pervasives
+
+type t = {id: string; port: int; exec: [`Client] Tezos_executable.t}
+type client = t
+
+let of_node ~exec n =
+  let id = sprintf "C-%s" n.Tezos_node.id in
+  let port = n.Tezos_node.rpc_port in
+  {id; port; exec}
+
+let base_dir t ~state = Paths.root state // sprintf "Client-base-%s" t.id
+
+open Tezos_executable.Make_cli
+
+let client_command t ~state args =
+  Tezos_executable.call t.exec
+    ~path:(base_dir t ~state // "exec-client")
+    (optf "port" "%d" t.port @ opt "base-dir" (base_dir ~state t) @ args)
+
+let bootstrapped_script t ~state =
+  let open Genspio.EDSL in
+  let cmd =
+    loop_until_true ~attempts:5 ~sleep:1
+      ~on_failed_attempt:(fun _ ->
+        eprintf (str "Bootstrap attempt failed\\n") [] )
+      (succeeds (client_command t ~state ["bootstrapped"]))
+  in
+  seq
+    [ exec ["mkdir"; "-p"; base_dir ~state t]
+    ; if_seq cmd ~t:[eprintf (str "Node Bootstrapped\\n") []] ]
+
+let bootstrapped t ~state =
+  let genspio = bootstrapped_script t ~state in
+  Running_processes.run_genspio state (sprintf "bootstrap-%s" t.id) genspio
+  >>= fun _ -> return ()
+
+let import_secret_key_script t ~state name key =
+  client_command t ~state ["import"; "secret"; "key"; name; key; "--force"]
+
+let activate_protocol_script t ~state protocol =
+  let open Genspio.EDSL in
+  check_sequence ~verbosity:(`Announce "activating-protocol")
+    [ ( "add-activator-key"
+      , import_secret_key_script t ~state
+          (Tezos_protocol.dictator_name protocol)
+          (Tezos_protocol.dictator_secret_key protocol) )
+    ; ( "activate-protocol"
+      , ensure "activate-alpha-only-once"
+          ~condition:
+            (greps_to
+               (str protocol.Tezos_protocol.hash)
+               (client_command t ~state
+                  ["rpc"; "get"; "/chains/main/blocks/head/metadata"]))
+          ~how:
+            [ ( "activate"
+              , client_command t ~state @@ opt "block" "genesis"
+                @ [ "activate"; "protocol"; protocol.Tezos_protocol.hash; "with"
+                  ; "fitness"
+                  ; sprintf "%d" protocol.Tezos_protocol.expected_pow
+                  ; "and"; "key"
+                  ; Tezos_protocol.dictator_name protocol
+                  ; "and"; "parameters"
+                  ; Tezos_protocol.protocol_parameters_path ~config:state
+                      protocol ] ) ] ) ]
+
+let import_secret_key t ~state name key =
+  Running_processes.run_genspio state
+    (sprintf "client-%s-import-key-%s-as-%s" t.id name key)
+    (import_secret_key_script t ~state name key)
+  >>= fun _ -> return ()
+
+let register_as_delegate t ~state keyname =
+  Running_processes.run_genspio state
+    (sprintf "client-%s-register-as-delegate-for-%s" t.id keyname)
+    Genspio.EDSL.(
+      if_seq
+        ( succeeds
+        @@ client_command t ~state
+             ["register"; "key"; keyname; "as"; "delegate"] )
+        ~t:[say "SUCCESS: Registering %s as delegate" [str keyname]]
+        ~e:[say "FAILURE: Registering %s as delegate" [str keyname]])
+  >>= fun _ -> return ()
+
+let activate_protocol t ~state protocol =
+  Running_processes.run_genspio state
+    (sprintf "activate_protocol-%s-%s" t.id protocol.Tezos_protocol.id)
+    (activate_protocol_script t ~state protocol)
+  >>= fun _ -> return ()
+
+module Command_error = struct
+  type t = [`Client_command_error of string * string list option]
+
+  let failf ?args fmt =
+    ksprintf (fun s -> fail (`Client_command_error (s, args) : [> t])) fmt
+
+  let pp fmt (`Client_command_error (msg, args) : t) =
+    Format.fprintf fmt "Client-command-error:@ %s%s" msg
+      (Option.value_map args ~default:"" ~f:(fun l ->
+           sprintf " (args: %s)"
+             (List.map ~f:(sprintf "%S") l |> String.concat ~sep:", ") ))
+end
+
+open Command_error
+open Console
+
+let successful_client_cmd state ~client args =
+  Running_processes.run_cmdf state "sh -c %s"
+    ( client_command client ~state args
+    |> Genspio.Compile.to_one_liner |> Filename.quote )
+  >>= fun res ->
+  Console.display_errors_of_command state res
+  >>= function
+  | true -> return res
+  | false ->
+      failf ~args "Client-command failure: %s" (String.concat ~sep:" " args)
+
+let rpc state ~client meth ~path =
+  let args =
+    match meth with
+    | `Get -> ["rpc"; "get"; path]
+    | `Post s -> ["rpc"; "post"; path; "with"; s]
+  in
+  successful_client_cmd state ~client args
+  >>= fun res ->
+  let output = String.concat ~sep:"\n" res#out in
+  try
+    let json = Jqo.of_string output in
+    return json
+  with e -> (
+    try
+      Ezjsonm.from_string (sprintf "[ %s ]" output)
+      |> function `A [one] -> return one | _ -> raise e
+    with e ->
+      say state
+        EF.(
+          list
+            [ desc (shout "Output:") (markdown_verbatim output)
+            ; desc (shout "Error:")
+                (markdown_verbatim (String.concat ~sep:"\n" res#err)) ])
+      >>= fun () ->
+      failf ~args "RPC failure cannot parse json: %s" Exn.(to_string e) )
+
+let find_applied_in_mempool state ~client ~f =
+  successful_client_cmd state ~client
+    ["rpc"; "get"; "/chains/main/mempool/pending_operations"]
+  >>= fun res ->
+  try
+    let json = Jqo.of_string (String.concat ~sep:"\n" res#out) in
+    let found = Jqo.field ~k:"applied" json |> Jqo.list_find ~f in
+    say state
+      EF.(
+        desc
+          (af "piece of mempool found (client %s):" client.id)
+          (markdown_verbatim (Ezjsonm.to_string json)))
+    >>= fun () -> return (Some found)
+  with e ->
+    say state
+      EF.(desc (shout "not found in mempool") (af "%s" (Exn.to_string e)))
+    >>= fun () -> return None
+
+let mempool_has_operation state ~client ~kind =
+  find_applied_in_mempool state ~client ~f:(fun o ->
+      Jqo.field o ~k:"contents"
+      |> Jqo.list_exists ~f:(fun op -> Jqo.field op ~k:"kind" = `String kind)
+  )
+  >>= fun found_or_not -> return (found_or_not <> None)
+
+let block_has_operation state ~client ~level ~kind =
+  successful_client_cmd state ~client
+    ["rpc"; "get"; sprintf "/chains/main/blocks/%d/operations" level]
+  >>= fun res ->
+  try
+    let json = Jqo.of_string (String.concat ~sep:"\n" res#out) in
+    let found =
+      Jqo.list_exists json ~f:(fun olist ->
+          Jqo.list_exists olist ~f:(fun o ->
+              Jqo.field o ~k:"contents"
+              |> Jqo.list_exists ~f:(fun op ->
+                     Jqo.field op ~k:"kind" = `String kind ) ) )
+    in
+    say state
+      EF.(
+        desc
+          (af "looking for %S in block %d: %sfound" kind level
+             (if found then "" else "not "))
+          (af "%s" (Ezjsonm.to_string json)))
+    >>= fun () -> return found
+  with e ->
+    say state
+      EF.(
+        desc
+          (ksprintf shout "Operation %S not found in block" kind)
+          (af "%s" (Exn.to_string e)))
+    >>= fun () -> return false
+
+let get_block_header state ~client block =
+  let path =
+    sprintf "/chains/main/blocks/%s/header"
+      (match block with `Head -> "head" | `Level i -> Int.to_string i)
+  in
+  rpc state ~client `Get ~path
+
+module Keyed = struct
+  type t = {client: client; key_name: string; secret_key: string}
+
+  let make client ~key_name ~secret_key = {client; key_name; secret_key}
+
+  let initialize state {client; key_name; secret_key} =
+    successful_client_cmd state ~client
+      ["import"; "secret"; "key"; key_name; secret_key; "--force"]
+
+  let bake state baker msg =
+    successful_client_cmd state ~client:baker.client
+      ["bake"; "for"; baker.key_name; "--force"; "--minimal-timestamp"]
+    >>= fun res ->
+    Log_recorder.Operations.bake state ~client:baker.client.id ~output:res#out
+      msg ;
+    say state
+      EF.(
+        desc
+          (af "Successful bake (%s: %s):" baker.client.id msg)
+          (ocaml_string_list res#out))
+
+  let endorse state baker msg =
+    successful_client_cmd state ~client:baker.client
+      ["endorse"; "for"; baker.key_name]
+    >>= fun res ->
+    Log_recorder.Operations.endorse state ~client:baker.client.id
+      ~output:res#out msg ;
+    say state
+      EF.(
+        desc
+          (af "Successful bake (%s: %s):" baker.client.id msg)
+          (ocaml_string_list res#out))
+
+  let forge_and_inject state {client; key_name; _} ~json =
+    rpc state ~client ~path:"/chains/main/blocks/head/helpers/forge/operations"
+      (`Post (Ezjsonm.to_string json))
+    >>= fun res ->
+    let operation_bytes =
+      match res with `String s -> s | _ -> assert false
+    in
+    let bytes_to_sign = "0x03" ^ operation_bytes in
+    successful_client_cmd state ~client
+      ["sign"; "bytes"; bytes_to_sign; "for"; key_name]
+    >>= fun sign_res ->
+    let to_decode =
+      List.hd_exn sign_res#out
+      |> String.chop_prefix_exn ~prefix:"Signature:"
+      |> String.strip
+    in
+    say state EF.(desc (shout "TO DECODE:") (af "%S" to_decode))
+    >>= fun () ->
+    let decoded =
+      Option.value_exn ~message:"base58 dec"
+        (Tezos_crypto.Base58.safe_decode to_decode)
+      |> Hex.of_string ?ignore:None |> Hex.show
+    in
+    say state EF.(desc (shout "DECODED:") (af "%S" decoded))
+    >>= fun () ->
+    let actual_signature =
+      String.chop_prefix_exn ~prefix:"09f5cd8612" decoded
+    in
+    say state
+      EF.(
+        desc_list (af "Injecting Operation")
+          [ ef_json "Injecting" (json :> Ezjsonm.value)
+          ; desc (haf "op:")
+              (af "%d: %S" (String.length operation_bytes) operation_bytes)
+          ; desc (haf "sign:")
+              (af "%d: %S" (String.length actual_signature) actual_signature)
+          ])
+    >>= fun () ->
+    rpc state ~client ~path:"/injection/operation?chain=main"
+      (`Post (sprintf "\"%s%s\"" operation_bytes actual_signature))
+end
diff --git a/src/lib_network_sandbox/tezos_client.mli b/src/lib_network_sandbox/tezos_client.mli
new file mode 100644
index 000000000000..49c8b679baa3
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_client.mli
@@ -0,0 +1,188 @@
+(** Wrapper around the main ["tezos-client"] application. *)
+open Internal_pervasives
+
+type t = private {id: string; port: int; exec: [`Client] Tezos_executable.t}
+type client = t
+
+val of_node : exec:[`Client] Tezos_executable.t -> Tezos_node.t -> t
+(** Create a client which is meant to communicate with a given node. *)
+
+val base_dir : t -> state:< paths: Paths.t ; .. > -> string
+
+val client_command :
+  t -> state:< paths: Paths.t ; .. > -> string list -> unit Genspio.EDSL.t
+(** {3 Build Scripts } *)
+
+val bootstrapped_script :
+  t -> state:< paths: Paths.t ; .. > -> unit Genspio.EDSL.t
+
+val import_secret_key_script :
+  t -> state:< paths: Paths.t ; .. > -> string -> string -> unit Genspio.EDSL.t
+
+val activate_protocol_script :
+  t -> state:< paths: Paths.t ; .. > -> Tezos_protocol.t -> unit Genspio.EDSL.t
+
+(** {3 Run Specific Client Commands } *)
+
+val bootstrapped :
+     t
+  -> state:< paths: Paths.t ; runner: Running_processes.State.t ; .. >
+  -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+(** Wait for the node to be bootstrapped. *)
+
+val import_secret_key :
+     t
+  -> state:< paths: Paths.t ; runner: Running_processes.State.t ; .. >
+  -> string
+  -> string
+  -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+
+val register_as_delegate :
+     t
+  -> state:< paths: Paths.t ; runner: Running_processes.State.t ; .. >
+  -> string
+  -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+
+val activate_protocol :
+     t
+  -> state:< paths: Paths.t ; runner: Running_processes.State.t ; .. >
+  -> Tezos_protocol.t
+  -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+
+module Command_error : sig
+  type t = [`Client_command_error of string * string list option]
+
+  val failf :
+       ?args:string list
+    -> ('a, unit, string, ('b, [> t]) Asynchronous_result.t) format4
+    -> 'a
+
+  val pp : Format.formatter -> t -> unit
+end
+
+val successful_client_cmd :
+     < application_name: string
+     ; console: Console.t
+     ; paths: Paths.t
+     ; runner: Running_processes.State.t
+     ; .. >
+  -> client:t
+  -> string list
+  -> ( < err: string list ; out: string list ; status: Unix.process_status >
+     , [> Command_error.t | `Lwt_exn of exn] )
+     Asynchronous_result.t
+
+val rpc :
+     < application_name: string
+     ; console: Console.t
+     ; paths: Paths.t
+     ; runner: Running_processes.State.t
+     ; .. >
+  -> client:t
+  -> [< `Get | `Post of string]
+  -> path:string
+  -> ( Ezjsonm.value
+     , [> Command_error.t | `Lwt_exn of exn] )
+     Asynchronous_result.t
+
+val find_applied_in_mempool :
+     < application_name: string
+     ; console: Console.t
+     ; paths: Paths.t
+     ; runner: Running_processes.State.t
+     ; .. >
+  -> client:client
+  -> f:(Ezjsonm.value -> bool)
+  -> ( Ezjsonm.value option
+     , [> Command_error.t | `Lwt_exn of exn] )
+     Asynchronous_result.t
+(** Use RPCs to find an operation matching [~f] in the node's mempool. *)
+
+val mempool_has_operation :
+     < application_name: string
+     ; console: Console.t
+     ; paths: Paths.t
+     ; runner: Running_processes.State.t
+     ; .. >
+  -> client:t
+  -> kind:string
+  -> (bool, [> Command_error.t | `Lwt_exn of exn]) Asynchronous_result.t
+(** Use RPCs to find an operation of kind [~kind] in the node's mempool. *)
+
+val block_has_operation :
+     < application_name: string
+     ; console: Console.t
+     ; paths: Paths.t
+     ; runner: Running_processes.State.t
+     ; .. >
+  -> client:t
+  -> level:int
+  -> kind:string
+  -> (bool, [> Command_error.t | `Lwt_exn of exn]) Asynchronous_result.t
+(** Use RPCs to find an operation of kind [~kind] in the node's chain
+    at a given level. *)
+
+val get_block_header :
+     < application_name: string
+     ; console: Console.t
+     ; paths: Paths.t
+     ; runner: Running_processes.State.t
+     ; .. >
+  -> client:t
+  -> [`Head | `Level of int]
+  -> ( Ezjsonm.value
+     , [> Command_error.t | `Lwt_exn of exn] )
+     Asynchronous_result.t
+(** Call the RPC ["/chains/main/blocks/<block>/header"]. *)
+
+module Keyed : sig
+  type t = {client: client; key_name: string; secret_key: string}
+
+  val make : client -> key_name:string -> secret_key:string -> t
+
+  val initialize :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> t
+    -> ( < err: string list ; out: string list ; status: Unix.process_status >
+       , [> Command_error.t | `Lwt_exn of exn] )
+       Asynchronous_result.t
+
+  val bake :
+       < application_name: string
+       ; console: Console.t
+       ; operations_log: Log_recorder.Operations.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> t
+    -> string
+    -> (unit, [> Command_error.t | `Lwt_exn of exn]) Asynchronous_result.t
+
+  val endorse :
+       < application_name: string
+       ; console: Console.t
+       ; operations_log: Log_recorder.Operations.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> t
+    -> string
+    -> (unit, [> Command_error.t | `Lwt_exn of exn]) Asynchronous_result.t
+
+  val forge_and_inject :
+       < application_name: string
+       ; console: Console.t
+       ; paths: Paths.t
+       ; runner: Running_processes.State.t
+       ; .. >
+    -> t
+    -> json:Ezjsonm.t
+    -> ( Ezjsonm.value
+       , [> `Client_command_error of string * string list option
+         | `Lwt_exn of exn ] )
+       Asynchronous_result.t
+end
diff --git a/src/lib_network_sandbox/tezos_daemon.ml b/src/lib_network_sandbox/tezos_daemon.ml
new file mode 100644
index 000000000000..e7c2bbef0d57
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_daemon.ml
@@ -0,0 +1,58 @@
+open Internal_pervasives
+
+type kind = [`Baker | `Endorser | `Accuser]
+
+type args =
+  | Baker : string -> args
+  | Endorser : string -> args
+  | Accuser : args
+
+type t =
+  { node: Tezos_node.t
+  ; client: Tezos_client.t
+  ; exec: kind Tezos_executable.t
+  ; args: args }
+
+let of_node node args ~exec ~client = {node; exec; client; args}
+let baker_of_node nod ~key = of_node nod (Baker key)
+let endorser_of_node nod ~key = of_node nod (Endorser key)
+let accuser_of_node nod = of_node nod Accuser
+
+let arg_to_string = function
+  | Baker k -> sprintf "baker-%s" k
+  | Endorser k -> sprintf "endorser-%s" k
+  | Accuser -> "accuser"
+
+let to_script (t : t) ~state =
+  let base_dir = Tezos_client.base_dir ~state t.client in
+  let call t args =
+    Tezos_executable.call t.exec
+      ~path:
+        ( base_dir
+        // sprintf "exec-%s-%d" (arg_to_string t.args)
+             t.node.Tezos_node.rpc_port )
+      args
+  in
+  match t.args with
+  | Baker key ->
+      let node_path = Tezos_node.data_dir ~config:state t.node in
+      call t
+        [ "--port"
+        ; sprintf "%d" t.node.Tezos_node.rpc_port
+        ; "--base-dir"; base_dir; "run"; "with"; "local"; "node"; node_path
+        ; key ]
+  | Endorser key ->
+      call t
+        [ "--port"
+        ; sprintf "%d" t.node.Tezos_node.rpc_port
+        ; "--base-dir"; base_dir; "run"; key ]
+  | Accuser ->
+      call t
+        [ "--port"
+        ; sprintf "%d" t.node.Tezos_node.rpc_port
+        ; "--base-dir"; base_dir; "run"; "--preserved-levels"; "10" ]
+
+let process (t : t) ~state =
+  Running_processes.Process.genspio
+    (sprintf "%s-for-%s" (arg_to_string t.args) t.node.Tezos_node.id)
+    (to_script t ~state)
diff --git a/src/lib_network_sandbox/tezos_daemon.mli b/src/lib_network_sandbox/tezos_daemon.mli
new file mode 100644
index 000000000000..ecacacce5d3a
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_daemon.mli
@@ -0,0 +1,40 @@
+type kind = [`Accuser | `Baker | `Endorser]
+
+type args = private
+  | Baker : string -> args
+  | Endorser : string -> args
+  | Accuser : args
+
+type t = private
+  { node: Tezos_node.t
+  ; client: Tezos_client.t
+  ; exec: kind Tezos_executable.t
+  ; args: args }
+
+val of_node :
+     Tezos_node.t
+  -> args
+  -> exec:kind Tezos_executable.t
+  -> client:Tezos_client.t
+  -> t
+
+val baker_of_node :
+     Tezos_node.t
+  -> key:string
+  -> exec:kind Tezos_executable.t
+  -> client:Tezos_client.t
+  -> t
+
+val endorser_of_node :
+     Tezos_node.t
+  -> key:string
+  -> exec:kind Tezos_executable.t
+  -> client:Tezos_client.t
+  -> t
+
+val accuser_of_node :
+  Tezos_node.t -> exec:kind Tezos_executable.t -> client:Tezos_client.t -> t
+
+val arg_to_string : args -> string
+val to_script : t -> state:< paths: Paths.t ; .. > -> unit Genspio.Language.t
+val process : t -> state:< paths: Paths.t ; .. > -> Running_processes.Process.t
diff --git a/src/lib_network_sandbox/tezos_executable.ml b/src/lib_network_sandbox/tezos_executable.ml
new file mode 100644
index 000000000000..6531f7dfc35a
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_executable.ml
@@ -0,0 +1,69 @@
+open Internal_pervasives
+
+module Make_cli = struct
+  let flag name = [sprintf "--%s" name]
+  let opt name s = [sprintf "--%s" name; s]
+  let optf name fmt = ksprintf (opt name) fmt
+end
+
+module Unix_files_sink = struct
+  type t = {matches: string list option; level_at_least: string}
+
+  let all_notices = {matches= None; level_at_least= "notice"}
+  let all_info = {matches= None; level_at_least= "info"}
+end
+
+type kind = [`Node | `Baker | `Endorser | `Accuser | `Client | `Admin]
+
+type 'kind t =
+  { kind:
+      'kind
+      (* if needed, it's easy to remove this overengineered type parameter. *)
+  ; binary: string option
+  ; unix_files_sink: Unix_files_sink.t option
+  ; environment: (string * string) list }
+
+let node ?binary ?unix_files_sink ?(environment = []) () =
+  {kind= `Node; binary; unix_files_sink; environment}
+
+let kind_string (kind : [< kind]) =
+  match kind with
+  | `Accuser -> "accuser-alpha"
+  | `Baker -> "baker-alpha"
+  | `Endorser -> "endorser-alpha"
+  | `Node -> "node"
+  | `Client -> "client"
+  | `Admin -> "admin-client"
+
+let default_binary t = sprintf "tezos-%s" (kind_string t.kind)
+
+let call (t : [< kind] t) ~path args =
+  let open Genspio.EDSL in
+  seq
+    ( Option.value_map t.unix_files_sink ~default:[] ~f:(function
+        | {matches= None; level_at_least} ->
+            [ setenv
+                ~var:(str "TEZOS_EVENTS_CONFIG")
+                (ksprintf str "unix-files://%s?level-at-least=%s"
+                   (path // "events") level_at_least) ]
+        | _other -> assert false )
+    @ [ exec ["mkdir"; "-p"; path]
+      ; write_stdout
+          ~path:(path // "last-cmd" |> str)
+          (printf (str "ARGS: %s\\n") [str (String.concat ~sep:" " args)])
+      ; exec (Option.value t.binary ~default:(default_binary t) :: args) ] )
+
+let cli_term kind prefix =
+  let open Cmdliner in
+  let open Term in
+  pure (fun binary ->
+      { kind
+      ; binary
+      ; unix_files_sink= Some Unix_files_sink.all_info
+      ; environment= [] } )
+  $ Arg.(
+      value
+      & opt (some string) None
+      & info
+          [sprintf "%s-%s-binary" prefix (kind_string kind)]
+          ~doc:(sprintf "Binary for the `tezos-%s` to use." (kind_string kind)))
diff --git a/src/lib_network_sandbox/tezos_executable.mli b/src/lib_network_sandbox/tezos_executable.mli
new file mode 100644
index 000000000000..16b3c32cd0b4
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_executable.mli
@@ -0,0 +1,54 @@
+(** This module wraps the type ['kind t] around the notion of
+    tezos-excutable: a path to a binary with tezos-specific properties. *)
+
+(** Helper functions to construct exec-style command lines for
+    ["tezos-*"] applications. *)
+module Make_cli : sig
+  val flag : string -> string list
+  val opt : string -> string -> string list
+  val optf : string -> ('a, unit, string, string list) format4 -> 'a
+end
+
+(** Manipulate the ["TEZOS_EVENTS_CONFIG"] environment variable. *)
+module Unix_files_sink : sig
+  type t = private {matches: string list option; level_at_least: string}
+
+  val all_notices : t
+  val all_info : t
+end
+
+(** The type [kind] is used to distinguish ['a t] executables. *)
+type kind = [`Node | `Baker | `Endorser | `Accuser | `Client | `Admin]
+
+(** The wrapper of the tezos-executable. *)
+type 'kind t = private
+  { kind: 'kind
+  ; binary: string option
+  ; unix_files_sink: Unix_files_sink.t option
+  ; environment: (string * string) list }
+
+val node :
+     ?binary:string
+  -> ?unix_files_sink:Unix_files_sink.t
+  -> ?environment:(string * string) list
+  -> unit
+  -> [> `Node] t
+(** Create a ["tezos-node"] executable. *)
+
+val kind_string : [< kind] -> string
+(** Convert a [kind] to a [string]. *)
+
+val default_binary : [< kind] t -> string
+(** Get the path/name of the default binary for a given kind, e.g.,
+    ["tezos-admin-client"]. *)
+
+val call : [< kind] t -> path:string -> string list -> unit Genspio.EDSL.t
+(** Build a [Genspio.EDSL.t] script to run a tezos command, the
+    [~path] argument is used as a toplevel path for the unix-files
+    event-sink (event-logging-framework) and for other local logging
+    files. *)
+
+val cli_term : ([< kind] as 'a) -> string -> 'a t Cmdliner.Term.t
+(** Build a [Cmdliner] term which creates tezos-executables, the
+    second argument is a prefix of option names (e.g. ["tezos"] for the
+    option ["--tezos-accuser-alpha-binary"]). *)
diff --git a/src/lib_network_sandbox/tezos_node.ml b/src/lib_network_sandbox/tezos_node.ml
new file mode 100644
index 000000000000..1f9ecd914a4a
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_node.ml
@@ -0,0 +1,131 @@
+open Internal_pervasives
+
+type t =
+  { id: string
+  ; expected_connections: int
+  ; rpc_port: int
+  ; p2p_port: int
+  ; (* Ports: *)
+    peers: int list
+  ; exec: [`Node] Tezos_executable.t
+  ; protocol: Tezos_protocol.t }
+
+let ef t =
+  EF.(
+    desc_list (af "Node:%S" t.id)
+      [ desc (af "rpc") (af ":%d" t.rpc_port)
+      ; desc (af "p2p") (af ":%d" t.p2p_port)
+      ; desc_list (af "peers") (List.map t.peers ~f:(af ":%d")) ])
+
+let pp fmt t = Easy_format.Pretty.to_formatter fmt (ef t)
+
+let make ~exec ?(protocol = Tezos_protocol.default ()) id ~expected_connections
+    ~rpc_port ~p2p_port peers =
+  {id; expected_connections; rpc_port; p2p_port; peers; exec; protocol}
+
+let make_path p ~config t = Paths.root config // sprintf "node-%s" t.id // p
+
+(* Data-dir should not exist OR be fully functional. *)
+let data_dir ~config t = make_path "data-dir" ~config t
+let config_file ~config t = data_dir ~config t // "config.json"
+let identity_file ~config t = data_dir ~config t // "identity.json"
+let log_output ~config t = make_path "node-output.log" ~config t
+let exec_path ~config t = make_path ~config "exec" t
+
+open Tezos_executable.Make_cli
+
+let node_command t ~config cmd options =
+  Tezos_executable.call t.exec ~path:(exec_path t ~config)
+    ( cmd
+    @ opt "config-file" (config_file ~config t)
+    @ opt "data-dir" (data_dir ~config t)
+    @ options )
+
+let config_options t ~config =
+  opt "log-output" (log_output ~config t)
+  @ optf "rpc-addr" "0.0.0.0:%d" t.rpc_port
+  @ optf "net-addr" "0.0.0.0:%d" t.p2p_port
+  @ optf "expected-pow" "%d" (Tezos_protocol.expected_pow t.protocol)
+
+let run_command t ~config =
+  let peers = List.concat_map t.peers ~f:(optf "peer" "127.0.0.1:%d") in
+  node_command t ~config ["run"]
+    ( flag "private-mode" @ flag "no-bootstrap-peers" @ peers
+    @ optf "bootstrap-threshold" "0"
+    @ optf "connections" "%d" t.expected_connections
+    @ opt "sandbox" (Tezos_protocol.sandbox_path ~config t.protocol) )
+
+let start_script t ~config =
+  let open Genspio.EDSL in
+  let gen_id =
+    node_command t ~config
+      [ "identity"; "generate"
+      ; sprintf "%d" (Tezos_protocol.expected_pow t.protocol) ]
+      []
+  in
+  let tmp_config = tmp_file (config_file t ~config) in
+  check_sequence
+    ~verbosity:(`Announce (sprintf "Node-%s-start" t.id))
+    [ (let opts = config_options t ~config in
+       ( "config-init"
+       , if_seq
+           (file_exists (str (config_file t ~config)))
+           ~t:[node_command t ~config ["config"; "reset"] opts]
+           ~e:[node_command t ~config ["config"; "init"] opts] ))
+    ; ( "update-config"
+      , seq
+          [ write_stdout ~path:tmp_config#path
+              (exec
+                 [ "jq"
+                 ; {jq|.p2p += { "limits" : { "connection-timeout" : 2, "swap-linger" : 2 } }|jq}
+                 ; config_file t ~config ])
+          ; call [str "mv"; tmp_config#path; str (config_file t ~config)] ] )
+    ; ( "ensure-identity"
+      , ensure "node-id"
+          ~condition:(file_exists (str (identity_file t ~config)))
+          ~how:[("gen-id", gen_id)] )
+    ; ("start", run_command t ~config) ]
+
+let process config t =
+  Running_processes.Process.genspio t.id (start_script t ~config)
+
+let protocol t = t.protocol
+
+let connections node_list =
+  let module Connection = struct
+    type node = t
+
+    type t =
+      [ `Duplex of node * node
+      | `From_to of node * node
+      | `Missing of node * int ]
+
+    let compare a b =
+      match (a, b) with
+      | `Duplex (a, b), `Duplex (c, d) when a = d && b = c -> 0
+      | `Duplex _, _ -> -1
+      | _, `Duplex _ -> 1
+      | _, _ -> Caml.Pervasives.compare a b
+  end in
+  let module Connection_set = Set.Make (Connection) in
+  let res = ref Connection_set.empty in
+  List.iter node_list ~f:(fun node ->
+      let peer_nodes =
+        List.map node.peers ~f:(fun p2p ->
+            match
+              List.find node_list ~f:(fun {p2p_port; _} -> p2p_port = p2p)
+            with
+            | None -> `Unknown p2p
+            | Some n -> `Peer n )
+      in
+      List.iter peer_nodes ~f:(fun peer_opt ->
+          let conn =
+            match peer_opt with
+            | `Unknown p2p -> `Missing (node, p2p)
+            | `Peer peer ->
+                if List.mem peer.peers node.p2p_port ~equal:Int.equal then
+                  `Duplex (node, peer)
+                else `From_to (node, peer)
+          in
+          res := Connection_set.add conn !res ) ) ;
+  Connection_set.elements !res
diff --git a/src/lib_network_sandbox/tezos_node.mli b/src/lib_network_sandbox/tezos_node.mli
new file mode 100644
index 000000000000..6b038b3d8110
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_node.mli
@@ -0,0 +1,48 @@
+type t = private
+  { id: string
+  ; expected_connections: int
+  ; rpc_port: int
+  ; p2p_port: int
+  ; peers: int list
+  ; exec: [`Node] Tezos_executable.t
+  ; protocol: Tezos_protocol.t }
+
+val ef : t -> Easy_format.t
+val pp : Format.formatter -> t -> unit
+
+val make :
+     exec:[`Node] Tezos_executable.t
+  -> ?protocol:Tezos_protocol.t
+  -> string
+  -> expected_connections:int
+  -> rpc_port:int
+  -> p2p_port:int
+  -> int list
+  -> t
+
+val data_dir : config:< paths: Paths.t ; .. > -> t -> string
+val config_file : config:< paths: Paths.t ; .. > -> t -> string
+val identity_file : config:< paths: Paths.t ; .. > -> t -> string
+val log_output : config:< paths: Paths.t ; .. > -> t -> string
+val exec_path : config:< paths: Paths.t ; .. > -> t -> string
+
+val node_command :
+     t
+  -> config:< paths: Paths.t ; .. >
+  -> string list
+  -> string list
+  -> unit Genspio.Language.t
+
+val config_options : t -> config:< paths: Paths.t ; .. > -> string list
+
+val run_command :
+  t -> config:< paths: Paths.t ; .. > -> unit Genspio.Language.t
+
+val start_script :
+  t -> config:< paths: Paths.t ; .. > -> unit Genspio.Language.t
+
+val process : < paths: Paths.t ; .. > -> t -> Running_processes.Process.t
+val protocol : t -> Tezos_protocol.t
+
+val connections :
+  t list -> [`Duplex of t * t | `From_to of t * t | `Missing of t * int] list
diff --git a/src/lib_network_sandbox/tezos_protocol.ml b/src/lib_network_sandbox/tezos_protocol.ml
new file mode 100644
index 000000000000..9640fc3343fd
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_protocol.ml
@@ -0,0 +1,339 @@
+open Internal_pervasives
+
+module Key = struct
+  module Of_name = struct
+    type t =
+      { name: string
+      ; pkh: Tezos_crypto.Ed25519.Public_key_hash.t
+      ; pk: Tezos_crypto.Ed25519.Public_key.t
+      ; sk: Tezos_crypto.Ed25519.Secret_key.t }
+
+    let make name =
+      let seed =
+        Tezos_stdlib.MBytes.of_string
+          (String.concat ~sep:"" (List.init 42 ~f:(fun _ -> name)))
+      in
+      let pkh, pk, sk = Tezos_crypto.Ed25519.generate_key ~seed () in
+      {name; pkh; pk; sk}
+
+    let pubkey n = Tezos_crypto.Ed25519.Public_key.to_b58check (make n).pk
+
+    let pubkey_hash n =
+      Tezos_crypto.Ed25519.Public_key_hash.to_b58check (make n).pkh
+
+    let private_key n =
+      "unencrypted:" ^ Tezos_crypto.Ed25519.Secret_key.to_b58check (make n).sk
+  end
+end
+
+module Script = struct
+  type origin = [`Sandbox_faucet | `String of string]
+
+  let exn_tezos msg = function
+    | Ok o -> o
+    | Error el ->
+        Format.kasprintf failwith "Script-error: %s: %a" msg
+          Tezos_error_monad.Error_monad.pp_print_error el
+
+  let exn_shell msg res =
+    Tezos_client_alpha.Proto_alpha.Alpha_environment.wrap_error res
+    |> exn_tezos msg
+
+  let parse exprs =
+    Tezos_client_alpha.Michelson_v1_parser.(
+      (parse_expression exprs |> fst).expanded)
+
+  let code_of_json_exn s =
+    match Tezos_data_encoding.Data_encoding.Json.from_string s with
+    | Ok json ->
+        let repr =
+          Tezos_data_encoding.Data_encoding.Json.destruct
+            Tezos_client_alpha.Proto_alpha.Script_repr.encoding json
+        in
+        let ( (expr_code :
+                Tezos_client_alpha.Proto_alpha.Michelson_v1_primitives.prim
+                Tezos_micheline.Micheline.canonical)
+            , _ ) =
+          Tezos_client_alpha.Proto_alpha.Script_repr.(force_decode repr.code)
+          |> exn_shell "decoding script-repr"
+        in
+        let module Alph = Tezos_client_alpha.Proto_alpha in
+        let strings_node =
+          Alph.Michelson_v1_primitives.strings_of_prims expr_code
+          |> Alph.Alpha_environment.Micheline.root
+        in
+        Format.eprintf ">> %a\n%!" Tezos_micheline.Micheline_printer.print_expr
+          (Tezos_micheline.Micheline.map_node
+             (fun _ -> Tezos_micheline.Micheline_printer.{comment= None})
+             (fun x -> x)
+             strings_node) ;
+        expr_code
+    | Error e -> Format.kasprintf failwith "JSON-of-string: %s" e
+
+  let json_script_repr code storage =
+    match
+      Tezos_data_encoding.Data_encoding.Json.construct
+        Tezos_client_alpha.Proto_alpha.Script_repr.encoding
+        Tezos_client_alpha.Proto_alpha.Script_repr.
+          {code= lazy_expr code; storage= lazy_expr storage}
+    with
+    | `O _ as o -> (o : Ezjsonm.t)
+    | _other ->
+        Format.kasprintf failwith "JSON-of-script-repr: not a json object"
+
+  let original_json =
+    (* looks like "./src/bin_client/test/contracts/attic/faucet.tz" *)
+    {json|{ "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" } }|json}
+
+  let faucet_tz =
+    (* exactly "./src/bin_client/test/contracts/attic/faucet.tz" *)
+    {tz|
+{ 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 } }
+|tz}
+
+  let print code storage =
+    let json_repr = json_script_repr code storage in
+    Format.eprintf "script-repr: %s\n%!" (Ezjsonm.to_string json_repr) ;
+    ()
+
+  let load : origin -> _ = function
+    | `Sandbox_faucet ->
+        let code = code_of_json_exn original_json in
+        json_script_repr code (parse "0")
+    | `String s -> json_script_repr (parse s) (parse "0")
+
+  let test () =
+    let faucet_like =
+      {mich| {parameter key_hash ;
+  storage timestamp ;
+  code { { { DUP ; CAR ; DIP { CDR } } } ;
+         SWAP ;
+         PUSH int 300 ;
+         ADD @FIVE_MINUTES_LATER ;
+         NOW ;
+         { { COMPARE ; GE } ; IF {} { { UNIT ; FAILWITH } } } ;
+         IMPLICIT_ACCOUNT ;
+         PUSH mutez 1000000 ;
+         UNIT ;
+         TRANSFER_TOKENS ;
+         NIL operation ;
+         SWAP ;
+         CONS ;
+         DIP { NOW } ;
+         PAIR }} |mich}
+    in
+    print (parse faucet_like) (parse "0") ;
+    let original = code_of_json_exn original_json in
+    print original (parse "0") ;
+    (* print (parse faucet_tz) (parse "0") ; *)
+    ()
+end
+
+module Account = struct
+  type t =
+    | Of_name of string
+    | Key_pair of
+        { name: string
+        ; pubkey: string
+        ; pubkey_hash: string
+        ; private_key: string }
+
+  let of_name s = Of_name s
+  let of_namef fmt = ksprintf of_name fmt
+  let name = function Of_name n -> n | Key_pair k -> k.name
+
+  let key_pair name ~pubkey ~pubkey_hash ~private_key =
+    Key_pair {name; pubkey; pubkey_hash; private_key}
+
+  let pubkey = function
+    | Of_name n -> Key.Of_name.pubkey n
+    | Key_pair k -> k.pubkey
+
+  let pubkey_hash = function
+    | Of_name n -> Key.Of_name.pubkey_hash n
+    | Key_pair k -> k.pubkey_hash
+
+  let private_key = function
+    | Of_name n -> Key.Of_name.private_key n
+    | Key_pair k -> k.private_key
+end
+
+type t =
+  { id: string
+  ; bootstrap_accounts: (Account.t * int) list
+  ; dictator: Account.t
+  ; bootstrap_contracts: (Account.t * int * Script.origin) list
+  ; expected_pow: int
+  ; name: string (* e.g. alpha *)
+  ; hash: string
+  ; time_between_blocks: int list
+  ; blocks_per_roll_snapshot: int
+  ; blocks_per_voting_period: int
+  ; blocks_per_cycle: int
+  ; preserved_cycles: int
+  ; proof_of_work_threshold: int }
+
+let compare a b = String.compare a.id b.id
+
+let default () =
+  let dictator = Account.of_name "dictator-default" in
+  { id= "default-bootstrap"
+  ; bootstrap_accounts=
+      List.init 4 ~f:(fun n ->
+          (Account.of_namef "bootacc-%d" n, 4_000_000_000_000) )
+  ; dictator
+  ; bootstrap_contracts= [(dictator, 10_000_000, `Sandbox_faucet)]
+  ; expected_pow= 1
+  ; name= "alpha"
+  ; hash= "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK"
+  ; time_between_blocks= [2; 3]
+  ; blocks_per_roll_snapshot= 4
+  ; blocks_per_voting_period= 16
+  ; blocks_per_cycle= 8
+  ; preserved_cycles= 2
+  ; proof_of_work_threshold= -1 }
+
+let protocol_parameters_json t : Ezjsonm.t =
+  let open Ezjsonm in
+  let make_account (account, amount) =
+    strings [Account.pubkey account; sprintf "%d" amount]
+  in
+  let make_contract (deleg, amount, script) =
+    dict
+      [ ("delegate", string (Account.pubkey_hash deleg))
+      ; ("amount", ksprintf string "%d" amount)
+      ; ("script", (Script.load script :> Ezjsonm.value)) ]
+  in
+  dict
+    [ ( "bootstrap_accounts"
+      , list make_account (t.bootstrap_accounts @ [(t.dictator, 1)]) )
+    ; ("bootstrap_contracts", list make_contract t.bootstrap_contracts)
+    ; ("time_between_blocks", list (ksprintf string "%d") t.time_between_blocks)
+    ; ("blocks_per_roll_snapshot", int t.blocks_per_roll_snapshot)
+    ; ("blocks_per_voting_period", int t.blocks_per_voting_period)
+    ; ("blocks_per_cycle", int t.blocks_per_cycle)
+    ; ("preserved_cycles", int t.preserved_cycles)
+    ; ( "proof_of_work_threshold"
+      , ksprintf string "%d" t.proof_of_work_threshold ) ]
+
+let sandbox {dictator; _} =
+  let pk = Account.pubkey dictator in
+  Ezjsonm.to_string (`O [("genesis_pubkey", `String pk)])
+
+let protocol_parameters t =
+  Ezjsonm.to_string ~minify:false (protocol_parameters_json t)
+
+let expected_pow t = t.expected_pow
+let id t = t.id
+let bootstrap_accounts t = List.map ~f:fst t.bootstrap_accounts
+let dictator_name {dictator; _} = Account.name dictator
+let dictator_secret_key {dictator; _} = Account.private_key dictator
+let make_path config t = Paths.root config // sprintf "protocol-%s" (id t)
+let sandbox_path ~config t = make_path config t // "sandbox.json"
+
+let protocol_parameters_path ~config t =
+  make_path config t // "protocol_parameters.json"
+
+let ensure_script ~config t =
+  let open Genspio.EDSL in
+  let file string p =
+    let path = p ~config t in
+    ( Filename.basename path
+    , write_stdout ~path:(str path)
+        (feed ~string:(str (string t)) (exec ["cat"])) )
+  in
+  check_sequence
+    ~verbosity:(`Announce (sprintf "Ensure-protocol-%s" (id t)))
+    [ ("directory", exec ["mkdir"; "-p"; make_path config t])
+    ; file sandbox sandbox_path
+    ; file protocol_parameters protocol_parameters_path ]
+
+let ensure t ~config =
+  match
+    Sys.command (Genspio.Compile.to_one_liner (ensure_script ~config t))
+  with
+  | 0 -> return ()
+  | _other ->
+      Lwt_exception.fail (Failure "sys.command non-zero")
+        ~attach:[("location", "Tezos_protocol.ensure")]
+
+let cli_term () =
+  let open Cmdliner in
+  let open Term in
+  pure (fun remove_default_bas (`Time_between_blocks tbb) add_bootstraps ->
+      let d = default () in
+      let id =
+        if add_bootstraps = [] && remove_default_bas = false then d.id
+        else "default-and-command-line"
+      in
+      let time_between_blocks =
+        Option.value tbb ~default:d.time_between_blocks
+      in
+      let bootstrap_accounts =
+        add_bootstraps
+        @ if remove_default_bas then [] else d.bootstrap_accounts
+      in
+      {d with id; bootstrap_accounts; time_between_blocks} )
+  $ Arg.(
+      value
+        (flag
+           (info ~doc:"Do not create any of the default bootstrap accounts."
+              ["remove-default-bootstrap-accounts"])))
+  $ Arg.(
+      pure (fun x -> `Time_between_blocks x)
+      $ value
+          (opt
+             (some (list ~sep:',' int))
+             None
+             (info ["time-between-blocks"] ~docv:"COMMA-SEPARATED-SECONDS"
+                ~doc:
+                  "Set the time between blocks bootstrap-parameter, e.g. \
+                   `2,3,2`.")))
+  $ Arg.(
+      pure (fun l ->
+          List.map l ~f:(fun ((name, pubkey, pubkey_hash, private_key), tez) ->
+              (Account.key_pair name ~pubkey ~pubkey_hash ~private_key, tez) )
+      )
+      $ value
+          (opt_all
+             (pair ~sep:'@' (t4 ~sep:',' string string string string) int)
+             []
+             (info ["add-bootstrap-account"]
+                ~docv:"NAME,PUBKEY,PUBKEY-HASH,PRIVATE-URI@MUTEZ-AMOUNT"
+                ~doc:
+                  "Add a custom bootstrap account, e.g. \
+                   `LedgerBaker,edpku...,tz1YPS...,ledger://crouching-tiger.../ed25519/0'/0'@20_000_000_000`.")))
diff --git a/src/lib_network_sandbox/tezos_protocol.mli b/src/lib_network_sandbox/tezos_protocol.mli
new file mode 100644
index 000000000000..5279ca2a2ee3
--- /dev/null
+++ b/src/lib_network_sandbox/tezos_protocol.mli
@@ -0,0 +1,110 @@
+(** Create and manipulate bootstrap-parameters and accounts. *)
+
+open Internal_pervasives
+
+(** Manipulate public/private key pairs. *)
+module Key : sig
+  (** Deterministically generate public/private key (hashes) from
+      given strings. *)
+  module Of_name : sig
+    val pubkey : string -> string
+    val pubkey_hash : string -> string
+    val private_key : string -> string
+  end
+end
+
+(** Create and transform Michelson programs. *)
+module Script : sig
+  type origin = [`Sandbox_faucet | `String of string]
+
+  val parse :
+    string -> Tezos_client_alpha.Proto_alpha.Alpha_context.Script.expr
+
+  val code_of_json_exn :
+       string
+    -> Tezos_client_alpha.Proto_alpha.Michelson_v1_primitives.prim
+       Tezos_micheline.Micheline.canonical
+
+  val json_script_repr :
+       Tezos_client_alpha.Proto_alpha.Script_repr.expr
+    -> Tezos_client_alpha.Proto_alpha.Script_repr.expr
+    -> Ezjsonm.t
+
+  val original_json : string
+  val faucet_tz : string
+
+  val print :
+       Tezos_client_alpha.Proto_alpha.Script_repr.expr
+    -> Tezos_client_alpha.Proto_alpha.Script_repr.expr
+    -> unit
+
+  val load : origin -> Ezjsonm.t
+  val test : unit -> unit
+end
+
+(** An account is a named key-pair. *)
+module Account : sig
+  type t = private
+    | Of_name of string
+    | Key_pair of
+        { name: string
+        ; pubkey: string
+        ; pubkey_hash: string
+        ; private_key: string }
+
+  val of_name : string -> t
+  val of_namef : ('a, unit, string, t) format4 -> 'a
+
+  val key_pair :
+    string -> pubkey:string -> pubkey_hash:string -> private_key:string -> t
+
+  val name : t -> string
+  val pubkey : t -> string
+  val pubkey_hash : t -> string
+  val private_key : t -> string
+end
+
+(** [t] wraps bootstrap parameters for sandboxed protocols. *)
+type t =
+  { id: string
+  ; bootstrap_accounts: (Account.t * int) list
+  ; dictator: Account.t
+  ; bootstrap_contracts: (Account.t * int * Script.origin) list
+  ; expected_pow: int
+  ; name: string
+  ; hash: string
+  ; time_between_blocks: int list
+  ; blocks_per_roll_snapshot: int
+  ; blocks_per_voting_period: int
+  ; blocks_per_cycle: int
+  ; preserved_cycles: int
+  ; proof_of_work_threshold: int }
+
+val compare : t -> t -> int
+val default : unit -> t
+val protocol_parameters_json : t -> Ezjsonm.t
+val sandbox : t -> string
+val protocol_parameters : t -> string
+val expected_pow : t -> int
+val id : t -> string
+val bootstrap_accounts : t -> Account.t list
+val dictator_name : t -> string
+val dictator_secret_key : t -> string
+val sandbox_path : config:< paths: Paths.t ; .. > -> t -> string
+val protocol_parameters_path : config:< paths: Paths.t ; .. > -> t -> string
+
+val ensure_script :
+  config:< paths: Paths.t ; .. > -> t -> unit Genspio.Language.t
+(** Build a {!Genspio.EDSL.t} script which generates the
+    bootstrap-parameters JSON file. *)
+
+val ensure :
+     t
+  -> config:< paths: Paths.t ; .. >
+  -> (unit, [> `Lwt_exn of exn]) Asynchronous_result.t
+(** Run the script created by [ensure_script], i.e. create the JSON
+    bootstrap parameters. *)
+
+val cli_term : unit -> t Cmdliner.Term.t
+(** Create a [Cmdliner] term which configures protocol-parameters
+    (e.g. options like ["--time-between-blocks"]). *)
-- 
GitLab