Merge branch 'work-on-script'.

.dockerignore

@@ -0,0 +1,67 @@
+.git
+
+tezos-node
+tezos-protocol-compiler
+tezos-client
+tezos-webclient
+tezos-attacker
+
+src/Makefile.local
+
+src/webclient_static.ml
+src/.depend
+
+src/node/updater/environment_gen
+src/node/updater/proto_environment.mli
+src/compiler/embedded_cmis.ml
+
+src/proto/**/_tzbuild
+src/proto/register_client_*.ml
+src/client/embedded/**/_tzbuild
+
+src/client/embedded/demo/.depend
+
+src/client/embedded/bootstrap/.depend
+src/client/embedded/bootstrap/concrete_lexer.ml
+src/client/embedded/bootstrap/concrete_parser.ml
+src/client/embedded/bootstrap/concrete_parser.mli
+src/client/embedded/bootstrap/webclient_proto_static.ml
+src/client/embedded/bootstrap/main.byte
+src/client/embedded/bootstrap/webclient_static/main.js
+src/client/embedded/bootstrap/webclient/browser/main.byte
+src/client/embedded/bootstrap/webclient/static/main.js
+src/client/embedded/bootstrap/webclient/webclient_proto_static.ml
+
+test/.depend
+test/reports
+
+test/test-store
+test/test-state
+test/test-context
+test/test-basic
+test/test-data-encoding
+test/test-p2p-io-scheduler
+test/test-p2p-connection
+test/test-p2p-connection-pool
+test/LOG
+
+**/*~
+**/\#*\#
+
+**/*.[oa]
+**/*.so
+**/*~
+**/*.cm[iaoxt]
+**/*.cmti
+**/*.cmxa
+**/*.cmxs
+**/*.cmp
+**/*.mli.deps
+**/*.ml.deps
+**/*.mli.deps.byte
+**/*.ml.deps.byte
+
+**/bisect*.out
+
+**/*.rej
+**/*.orig

.gitlab-ci.yml

@@ -1,10 +1,10 @@
 variables:
-  ocaml_image: alpine_ocaml-4.03.0
+  image_name: ocp_tezos
-  build_image_name: ocp_tezos_build
+  image_id: ${CI_BUILD_REF_NAME}
+  build_image_name: ${image_name}_build_deps
   build_image_id: ${CI_BUILD_REF}
-  build_image: ${build_image_name}:${ocaml_image}
 
-image: ${build_image}_${build_image_id}
+image: ${build_image_name}:${build_image_id}
 
 stages:
   - build_deps
@@ -21,8 +21,8 @@ build_deps:
   tags:
     - docker_builder
   script:
-    - ./scripts/create_docker_builder.sh
+    - ./scripts/create_build_deps_docker_image.sh
-        ${build_image_name} ${ocaml_image} "_${build_image_id}"
+        ${build_image_name} ${build_image_id}
 
 build:
   stage: build
@@ -137,15 +137,29 @@ test:p2p-connection-pool:
     - build
     - build:test
 
-expurge:
+publish:docker:
-  stage: expurge
+  stage: publish
+  image: ocp:docker
+  tags:
+    - docker_builder
+  script:
+    - ./scripts/create_docker_image.sh ${image_name} ${build_image_id}
+    - docker tag ${image_name}:${build_image_id}
+        "$CI_REGISTRY_IMAGE:$CI_BUILD_REF_NAME"
+    - docker login -u gitlab-ci-token -p $CI_BUILD_TOKEN $CI_REGISTRY
+    - docker push "$CI_REGISTRY_IMAGE:$CI_BUILD_REF_NAME"
+    - docker rmi "$CI_REGISTRY_IMAGE:$CI_BUILD_REF_NAME"
+
+publish:github:
+  image: ocaml/opam
+  stage: publish
   tags:
     - tezos_builder
   only:
     - master@tezos/tezos
   script:
     - echo "${CI_KH}" > ~/.ssh/known_hosts
-    - echo "${CI_PK_GITLAB}" > ~/.ssh/id_rsa
+    - echo "${CI_PK_GITHUB}" > ~/.ssh/id_rsa
     - chmod 400 ~/.ssh/id_rsa
     - rm -fr .git/refs/original
     - git filter-branch --prune-empty --index-filter
@@ -162,22 +176,6 @@ expurge:
                export GIT_AUTHOR_EMAIL="contact@tezos.com" ;
              fi'
          HEAD
-    - git tag ${CI_BUILD_REF}_expurged
-    - git push git@gitlab.ocamlpro.com:${CI_PROJECT_PATH}.git
-               -f --tags HEAD:master-expurged
-
-publish:github:
-  image: ocaml/opam:${ocaml_image}
-  stage: publish
-  tags:
-    - tezos_builder
-  only:
-    - master@tezos/tezos
-  script:
-    - echo "${CI_KH}" > ~/.ssh/known_hosts
-    - echo "${CI_PK_GITHUB}" > ~/.ssh/id_rsa
-    - chmod 400 ~/.ssh/id_rsa
-    - git reset ${CI_BUILD_REF}_expurged
     - git push git@github.com:tezos/tezos.git -f HEAD:master
 
 cleanup:
@@ -186,7 +184,7 @@ cleanup:
   tags:
     - docker_builder
   script:
-    - docker tag ${build_image}_${build_image_id}
+    - docker tag ${build_image_name}:${build_image_id}
-                 ${build_image}_${CI_PROJECT_NAMESPACE}_${CI_BUILD_REF_NAME}
+                 ${build_image_name}:${CI_PROJECT_NAMESPACE}_${CI_BUILD_REF_NAME}
-    - docker rmi ${build_image}_${build_image_id}
+    - docker rmi ${build_image_name}:${build_image_id}
   when: always

Makefile

@@ -6,9 +6,16 @@ clean:
 	${MAKE} -C src clean
 	${MAKE} -C test clean
 
+partial-clean:
+	${MAKE} -C src partial-clean
+	${MAKE} -C test clean
+
 .PHONY: test
 test:
 	${MAKE} -C test
 
 build-deps:
 	@./scripts/install_build_deps.sh all
+
+docker-image:
+	@./scripts/create_docker_image.sh

README.md

@@ -61,7 +61,7 @@ Running the node in a sandbox
 To run a single instance of a Tezos node in sandbox mode:
 
 ```
-./tezos-node --sandbox /path/to/a/custom/data/dir --rpc-addr :::8732
+./tezos-node --sandbox --rpc-addr :::8732
 ```
 
 This "sandboxed" node will not participate in the P2P network, but will accept
@@ -77,20 +77,22 @@ test network. Use the following command to run a node that will accept incoming
 connections:
 
 ```
-./tezos-node
+./tezos-node --generate-identity --expected-pow 24.
 ```
 
-The node will listen to connections coming in on `0.0.0.0:9732` (and
+This will first generate a new node identity and compute the associated stamp
-`[::]:9732`). All used data is stored at `$HOME/.tezos-node/`. For example,
+of proof-of-work. Then, the node will listen to connections coming in on
-the default configuration file is at `$HOME/.tezos-node/config`.
+`0.0.0.0:9732` (and`[::]:9732`). All used data is stored at
+`$HOME/.tezos-node/`. For example, the default configuration file is
+at `$HOME/.tezos-node/config.json`.
 
 To run multiple nodes on the same machine, you can duplicate and edit
-`$HOME/.tezos-node/config` while making sure they don't share paths to the
+`$HOME/.tezos-node/config.json` while making sure they don't share paths to the
 database or any other data file (cf. options `db.store` ; `db.context` ;
-`net.peers` and `protocol.dir`).
+`db.protocol`, `net.peers-metadata` and `net.identity`).
 
 You could also let Tezos generate a config file by specifying options on the
-command line. For instance, if `$dir/config` does not exist, the following
+command line. For instance, if `$dir/config.json` does not exist, the following
 command will generate it and replace the default values with the values from
 the command line:
 
@@ -102,20 +104,23 @@ The Tezos server has a built-in mechanism to discover peers on the local
 network (using UDP packets broadcasted on port 7732).
 
 If this mechanism is not sufficient, one can provide Tezos with a list of
-initial peers, either by editing the option `net.bootstrap.peers` in the
+initial peers, either by editing the option `net.bootstrap-peers` in the
-`config` file, or by specifying a command line parameter:
+`config.json` file, or by specifying a command line parameter:
 
 ```
 ./tezos-node --base-dir "$dir" --net-addr 127.0.0.1:2023 \
              --peer 127.0.0.1:2021 --peer 127.0.0.1:2022
 ```
 
-If `"$dir"/config` exists, the command line options override those read in the
+If `"$dir"/config.json` exists, the command line options override those
-config file. Tezos won't modify the content of an existing `"$dir"/config`
+read in the config file. By default, Tezos won't modify the content of an
-file.
+existing `"$dir"/config.json` file. But, you may explicit ask the node
+to reset or to update the file according to the command line parameters
+with the following commands line:
 
 ```
-./tezos-node --config-file "$dir"/config
+./tezos-node --reset-config --base-dir "$dir" --net-addr 127.0.0.1:9733
+./tezos-node --update-config --base-dir "$dir" --net-addr 127.0.0.1:9734
 ```
 
 
@@ -129,7 +134,7 @@ Typically, if you are not trying to run a local network and just want to
 explore the RPC, you would run:
 
 ```
-./tezos-node --sandbox /path/to/a/custom/data/dir --rpc-addr :::8732
+./tezos-node --sandbox --rpc-addr :::8732
 ```
 
 The RPC interface is self-documented and the `tezos-client` executable is able
@@ -151,7 +156,7 @@ You might also want the JSON schema describing the expected input and output of
 a RPC. For instance:
 
 ```
-./tezos-client rpc schema /block/genesis/hash
+./tezos-client rpc schema /blocks/genesis/hash
 ```
 
 Note: you can get the same information, but as a raw JSON object, with a simple
@@ -170,4 +175,4 @@ The minimal CLI client
 
 Work in progress.
 
-See `./tezos-client -help` for available commands.
+See `./tezos-client -help` for available commands.

scripts/Dockerfile.binaries.in

@@ -0,0 +1,24 @@
+FROM alpine:$alpine_version
+
+LABEL distro_style="apk" distro="alpine" distro_long="alpine-$alpine_version" arch="x86_64" operatingsystem="linux"
+
+RUN apk update && \
+    apk upgrade && \
+    apk add sudo bash libssl1.0 libsodium gmp && \
+    rm -f /var/cache/apk/* && \
+    adduser -S tezos && \
+    echo 'tezos ALL=(ALL:ALL) NOPASSWD:ALL' > /etc/sudoers.d/tezos && \
+    chmod 440 /etc/sudoers.d/tezos && \
+    chown root:root /etc/sudoers.d/tezos && \
+    sed -i 's/^Defaults.*requiretty//g' /etc/sudoers
+USER tezos
+
+COPY . /home/tezos
+WORKDIR /home/tezos
+
+RUN sudo chown root:root bin/* && \
+    sudo chmod a+rx bin/* && \
+    sudo mv bin/* /usr/local/bin && \
+    rmdir bin
+
+ENTRYPOINT [ "/bin/bash" ]

scripts/Dockerfile.build_bin.in

@@ -0,0 +1,7 @@
+FROM $base_name:$base_version
+
+COPY . /home/opam/tezos
+RUN sudo chown -R opam /home/opam/tezos && \
+    opam config exec -- make -C tezos -j4 && \
+    mkdir bin && \
+    cp tezos/tezos-* bin

scripts/Dockerfile.build_deps.in

@@ -0,0 +1,8 @@
+FROM ocaml/opam:alpine-$alpine_version_ocaml-$ocaml_version
+
+COPY scripts/install_build_deps.sh scripts/version.sh scripts/
+COPY src/tezos-deps.opam src/
+RUN sudo apk add libsodium-dev && \
+    opam config exec -- ./scripts/install_build_deps.sh all \
+    rm -fr ~/.opam/log/ \
+           "$(opam config exec -- ocamlfind query stdlib)"/topdirs.cmi

scripts/create_build_deps_docker_image.sh

@@ -0,0 +1,20 @@
+#! /bin/sh
+
+set -e
+set -x
+
+script_dir="$(dirname "$(readlink -f "$0")")"
+src_dir="$(dirname "$script_dir")"
+cd "$src_dir"
+
+. scripts/version.sh
+image_name="${1:-tezos_build_deps}"
+image_version="${2:-latest}"
+
+sed scripts/Dockerfile.build_deps.in \
+    -e 's/$alpine_version/'"$alpine_version"'/g' \
+    -e 's/$ocaml_version/'"$ocaml_version"'/g' > Dockerfile
+
+docker build --pull -t "$image_name:$image_version" .
+
+rm Dockerfile

scripts/create_docker_builder.sh

@@ -1,32 +0,0 @@
-#! /bin/sh
-
-set -x
-
-dir=$(mktemp -d)
-cur_dir="$(dirname "$(readlink -f "$0")")"
-
-image_name=${1:=tezos_build}
-ocaml_version=${2:=alpine_ocaml-4.03.0}
-image_version=$3
-
-docker pull ocaml/opam:${ocaml_version}
-
-cp ${cur_dir}/install_build_deps.sh ${dir}
-cp ${cur_dir}/../src/tezos-deps.opam ${dir}
-cat > ${dir}/Dockerfile <<EOF
-FROM ocaml/opam:${ocaml_version}
-COPY install_build_deps.sh /tmp
-COPY tezos-deps.opam /tmp/src/tezos-deps.opam
-RUN cd /tmp && opam config exec -- ./install_build_deps.sh pin \
-            && rm -fr ~/.opam/log/
-USER root
-ENV HOME /home/opam
-RUN cd /tmp && opam config exec -- ./install_build_deps.sh depext \
-            && rm -fr ~/.opam/log/
-RUN apk add libsodium-dev
-USER opam
-RUN cd /tmp && opam config exec -- ./install_build_deps.sh install \
-            && rm -fr ~/.opam/log/
-EOF
-
-docker build -t ${image_name}:${ocaml_version}${image_version} ${dir}

scripts/create_docker_image.sh

@@ -0,0 +1,41 @@
+#! /bin/sh
+
+set -e
+set -x
+
+script_dir="$(dirname "$(readlink -f "$0")")"
+src_dir="$(dirname "$script_dir")"
+cd "$src_dir"
+
+. scripts/version.sh
+image_name="${1:-tezos}"
+image_version="${2:-latest}"
+build_deps_image_name="$image_name"_build_deps
+
+echo Building dependencies...
+./scripts/create_build_deps_docker_image.sh \
+    "$build_deps_image_name" "$image_version"
+
+cleanup () {
+    set +e
+    echo Cleaning up...
+    [ -z "$tmp_container" ] || docker rm "$tmp_container"
+    [ -z "$tmp_image" ] || docker rmi "$tmp_image"
+    rm -rf Dockerfile bin
+}
+trap cleanup EXIT INT
+
+sed scripts/Dockerfile.build_bin.in \
+    -e 's/$base_name/'"$build_deps_image_name"'/g' \
+    -e 's/$base_version/'"$image_version"'/g'  > Dockerfile
+
+echo Building tezos...
+tmp_image="$(docker build -q .)"
+tmp_container="$(docker run -dit "$tmp_image" true)"
+
+docker cp "$tmp_container":/home/opam/bin/ bin
+
+echo Building minimal docker image...
+sed scripts/Dockerfile.binaries.in \
+    -e 's/$alpine_version/'"$alpine_version"'/g' > Dockerfile
+docker build -q -t "$image_name:$image_version" .

scripts/install_build_deps.sh

@@ -1,39 +1,40 @@
-#!/bin/sh
+#! /bin/sh
 
-if ! [ -f 'src/tezos-deps.opam' ]; then
+script_dir="$(dirname "$(readlink -f "$0")")"
-    echo
+src_dir="$(dirname "$script_dir")"
-    echo "   Please run from the project's root directory. Aborting."
+
-    echo
+. "$script_dir/version.sh"
-    exit 1
-fi
 
-ocaml_version=4.03.0
 if [ "$(ocaml -vnum)" != "$ocaml_version" ]; then
-    echo
+  echo ;
-    echo "   Unexpected compiler version ($(ocaml -vnum))"
+  echo "   Unexpected compiler version ($(ocaml -vnum))";
-    echo "   You should use ocaml-$ocaml_version."
+  echo "   You should use ocaml-$ocaml_version.";
-    echo
+  echo ;
-    exit 1
+  exit 1;
 fi
 
 cmd="$1"
 if [ -z "$cmd" ]; then cmd=all; fi
 
-case "$cmd" in
+pin=false
+depext=false
+install=false
+
+case $cmd in
     pin)
-        pin=yes
+	pin=true
-        ;;
+	;;
     depext)
-        depext=yes
+	depext=true
-        ;;
+	;;
     install)
-        install=yes
+	install=true
-        ;;
+	;;
     all)
-        pin=yes
+	pin=true
-        depext=yes
+	depext=true
-        install=yes
+	install=true
-        ;;
+	;;
     *)
         echo "Unknown command '$cmd'."
         echo "Usage: $0 [pin|depext|install|all|]"
@@ -43,7 +44,7 @@ esac
 set -e
 set -x
 
-if ! [ -z "$pin" ]; then
+if "$pin"; then
     opam pin --yes remove --no-action --dev-repo ocplib-resto || true
     opam pin --yes add --no-action --dev-repo sodium
     opam pin --yes add --no-action --dev-repo ocp-ocamlres
@@ -56,15 +57,15 @@ if ! [ -z "$pin" ]; then
     opam pin --yes add --no-action tezos-deps src
 fi
 
-if ! [ -z "$depext" ]; then
+if "$depext"; then
-    ## In our CI, this rule is executed as user 'root'
-    ## The other rules are executed as user 'opam'.
     opam list --installed depext || opam install depext
-    opam depext tezos-deps
+    opam depext $DEPEXTOPT tezos-deps
 fi
 
-if ! [ -z "$install" ]; then
+if "$install"; then
-    opam install tezos-deps
+    if opam list --installed tezos-deps ; then
-    ## This seems broken in the current opam-repo (2016-12-09)
+	opam upgrade $(opam list -s --required-by tezos-deps | grep -ve '^ocaml *$')
-    ## opam install --build-test tezos-deps
+    else
+	opam install tezos-deps
+    fi
 fi

scripts/version.sh

@@ -0,0 +1,4 @@
+#! /bin/sh
+
+alpine_version=3.5
+ocaml_version=4.03.0

src/Makefile

@@ -65,7 +65,7 @@ node/updater/proto_environment.cmi: \
 	@echo OCAMLOPT ${TARGET} $@
 	@$(OCAMLOPT) -nopervasives -nostdlib -opaque -I tmp -I node/updater -c $<
 
-clean::
+partial-clean::
 	rm -f node/updater/proto_environment.mli
 	rm -f node/updater/environment_gen
 
@@ -91,7 +91,7 @@ compiler/embedded_cmis.cmx: compiler/embedded_cmis.cmi
 compiler/embedded_cmis.ml: ${EMBEDDED_PROTOCOL_LIB_CMIS}
 	@echo OCAMLRES ${TARGET} $(notdir $@)
 	@$(OCAMLRES) -format ocaml -o $@ $^
-clean::
+partial-clean::
 	rm -f compiler/embedded_cmis.ml
 	rm -rf tmp
 
@@ -168,12 +168,12 @@ UTILS_LIB_INTFS := \
 UTILS_LIB_IMPLS := \
   utils/base48.ml \
   utils/cli_entries.ml \
+  utils/error_monad_sig.ml \
+  utils/error_monad.ml \
   utils/data_encoding_ezjsonm.ml \
   utils/time.ml \
   utils/hash.ml \
   utils/crypto_box.ml \
-  utils/error_monad_sig.ml \
-  utils/error_monad.ml \
   utils/lwt_exit.ml \
   utils/logging.ml \
   utils/lwt_utils.ml \
@@ -368,7 +368,7 @@ ${TZNODE}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa ${EMBEDDED_NODE_PROT
 	@echo LINK $(notdir $@)
 	@${OCAMLOPT} -linkall -linkpkg ${OCAMLFLAGS} -o $@ $^
 
-clean::
+partial-clean::
 	-rm -f proto/*.cm* proto/*.a
 
 ## Embedded protocol modules
@@ -399,8 +399,6 @@ proto/client_embedded_proto_%.cmxa: \
 	   $(addprefix -I , ${CLIENT_PROTO_INCLUDES}) \
 	   $@ proto/$*
 
-
-
 clean::
 	rm -f ${TZNODE}
 
@@ -529,7 +527,7 @@ client/embedded/webclient_%.cmx: \
   $$(shell find client/embedded/%/webclient/static/)
 	@$(MAKE) -C client/embedded/$* ../webclient_$*.cmx
 
-clean::
+partial-clean::
 	-for d in $$(ls -d client/embedded/*/) ; do make clean -C $$d ; done
 	-rm -f client/embedded/*.cm* client/embedded/*.o
 
@@ -601,8 +599,9 @@ clean::
 
 ## Cleaning
 
-.PHONY: clean
+.PHONY: clean partial-clean
-clean::
+clean:: partial-clean
+partial-clean::
 	-find \( -name \*.cm\* -or -name \*.cmp -or -name \*.out -or -name \*~ -or -name \*.o -or -name \*.a \) -delete
 
 ## Dependencies
@@ -652,6 +651,6 @@ compiler/tezos_compiler.cmo compiler/tezos_compiler.cmx: \
 	@echo OCAMLDEP ${TARGET} $(notdir $^)
 	@$(OCAMLDEP) $(INCLUDES) $^ > $@
 
-clean::
+partial-clean::
 	-rm -f .depend
 	-find \( -name \*.mli.deps -or -name \*.ml.deps \) -delete

src/client/client_aliases.ml

@@ -88,10 +88,10 @@ module Alias = functor (Entity : Entity) -> struct
     let filename = filename () in
     if not (Sys.file_exists filename) then return [] else
       Data_encoding_ezjsonm.read_file filename >>= function
-      | None ->
+      | Error _ ->
           cctxt.Client_commands.error
             "couldn't to read the %s alias file" Entity.name
-      | Some json ->
+      | Ok json ->
           match Data_encoding.Json.destruct encoding json with
           | exception _ -> (* TODO print_error *)
               cctxt.Client_commands.error
@@ -132,8 +132,8 @@ module Alias = functor (Entity : Entity) -> struct
          let filename = filename () in
          let json = Data_encoding.Json.construct encoding list in
          Data_encoding_ezjsonm.write_file filename json >>= function
-         | false -> fail (Failure "Json.write_file")
+         | Error _ -> fail (Failure "Json.write_file")
-         | true -> return ())
+         | Ok () -> return ())
       (fun exn ->
          cctxt.Client_commands.error
            "could not write the %s alias file: %s."

src/client/embedded/bootstrap/client_proto_nonces.ml

@@ -29,8 +29,9 @@ let load cctxt =
     Lwt.return []
   else
     Data_encoding_ezjsonm.read_file filename >>= function
-    | None -> cctxt.Client_commands.error "couldn't to read the nonces file"
+    | Error _ ->
-    | Some json ->
+        cctxt.Client_commands.error "couldn't to read the nonces file"
+    | Ok json ->
         match Data_encoding.Json.destruct encoding json with
         | exception _ -> (* TODO print_error *)
             cctxt.Client_commands.error "didn't understand the nonces file"
@@ -51,8 +52,8 @@ let save cctxt list =
        let filename = filename () in
        let json = Data_encoding.Json.construct encoding list in
        Data_encoding_ezjsonm.write_file filename json >>= function
-       | false -> failwith "Json.write_file"
+       | Error _ -> failwith "Json.write_file"
-       | true -> return ())
+       | Ok () -> return ())
     (fun exn ->
        cctxt.Client_commands.error
          "could not write the nonces file: %s." (Printexc.to_string exn))

src/client/embedded/bootstrap/mining/client_mining_endorsement.ml

@@ -51,9 +51,9 @@ end = struct
     let filename = filename () in
     if not (Sys.file_exists filename) then return LevelMap.empty else
       Data_encoding_ezjsonm.read_file filename >>= function
-      | None ->
+      | Error _ ->
           cctxt.Client_commands.error "couldn't to read the endorsement file"
-      | Some json ->
+      | Ok json ->
           match Data_encoding.Json.destruct encoding json with
           | exception _ -> (* TODO print_error *)
               cctxt.Client_commands.error "didn't understand the endorsement file"
@@ -69,8 +69,8 @@ end = struct
          let filename = filename () in
          let json = Data_encoding.Json.construct encoding map in
          Data_encoding_ezjsonm.write_file filename json >>= function
-         | false -> failwith "Json.write_file"
+         | Error _ -> failwith "Json.write_file"
-         | true -> return ())
+         | Ok () -> return ())
       (fun exn ->
          cctxt.Client_commands.error "could not write the endorsement file: %s."
            (Printexc.to_string exn))

src/client/embedded/bootstrap/mining/client_mining_forge.ml

@@ -171,9 +171,9 @@ end = struct
     let filename = filename () in
     if not (Sys.file_exists filename) then return LevelMap.empty else
       Data_encoding_ezjsonm.read_file filename >>= function
-      | None ->
+      | Error _ ->
           failwith "couldn't to read the block file"
-      | Some json ->
+      | Ok json ->
           match Data_encoding.Json.destruct encoding json with
           | exception _ -> (* TODO print_error *)
               failwith "didn't understand the block file"
@@ -189,8 +189,8 @@ end = struct
          let filename = filename () in
          let json = Data_encoding.Json.construct encoding map in
          Data_encoding_ezjsonm.write_file filename json >>= function
-         | false -> failwith "Json.write_file"
+         | Error _ -> failwith "Json.write_file"
-         | true -> return ())
+         | Ok () -> return ())
       (fun exn ->
          Error_monad.failwith
            "could not write the block file: %s."

src/minutils/utils.ml

@@ -9,13 +9,16 @@
 
 module StringMap = Map.Make (String)
 
-let split delim ?(limit = max_int) path =
+let split delim ?(dup = true) ?(limit = max_int) path =
   let l = String.length path in
   let rec do_slashes acc limit i =
     if i >= l then
       List.rev acc
     else if String.get path i = delim then
-      do_slashes acc limit (i + 1)
+      if dup then
+        do_slashes acc limit (i + 1)
+      else
+        do_split acc limit (i + 1)
     else
       do_split acc limit i
   and do_split acc limit i =
@@ -55,8 +58,8 @@ let iter_option ~f = function
   | None -> ()
   | Some x -> f x
 
-let unopt x = function
+let unopt ~default = function
-  | None -> x
+  | None -> default
   | Some x -> x
 
 let unopt_map ~f ~default = function
@@ -85,8 +88,16 @@ let list_sub l n = list_rev_sub l n |> List.rev
 
 let display_paragraph ppf description =
   Format.fprintf ppf "@[%a@]"
-    (fun ppf words -> List.iter (Format.fprintf ppf "%s@ ") words)
+    (Format.pp_print_list ~pp_sep:Format.pp_print_newline
-    (split ' ' description)
+       (fun ppf line ->
+          Format.pp_print_list ~pp_sep:Format.pp_print_space
+            (fun ppf w ->
+               (* replace   by real spaces... *)
+               Format.fprintf ppf "%s@ "
+                 (Stringext.replace_all ~pattern:"\xC2\xA0" ~with_:" " w))
+            ppf
+            (split ' ' line)))
+    (split ~dup:false '\n' description)
 
 let rec remove_elem_from_list nb = function
   | [] -> []
@@ -128,6 +139,8 @@ let rec (--) i j =
     if j < i then acc else loop (j :: acc) (pred j) in
   loop [] j
 
+let rec repeat n x = if n <= 0 then [] else x :: repeat (pred n) x
+
 let take_n_unsorted n l =
   let rec loop acc n = function
     | [] -> l

src/minutils/utils.mli

@@ -16,12 +16,12 @@ val split_path: string -> string list
 (** Splits a string on a delimier character, grouping multiple
     delimiters, and ignoring delimiters at the beginning and end of
     string, if [limit] is passed, stops after [limit] split(s). *)
-val split: char -> ?limit: int -> string -> string list
+val split: char -> ?dup:bool -> ?limit: int -> string -> string list
 
 val map_option: f:('a -> 'b) -> 'a option -> 'b option
 val apply_option: f:('a -> 'b option) -> 'a option -> 'b option
 val iter_option: f:('a -> unit) -> 'a option -> unit
-val unopt: 'a -> 'a option -> 'a
+val unopt: default:'a -> 'a option -> 'a
 val unopt_map: f:('a -> 'b) -> default:'b -> 'a option -> 'b
 val unopt_list: 'a option list -> 'a list
 val first_some: 'a option -> 'a option -> 'a option
@@ -51,6 +51,8 @@ val (<<) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c
 (** Sequence: [i--j] is the sequence [i;i+1;...;j-1;j] *)
 val (--) : int -> int -> int list
 
+val repeat: int -> 'a -> 'a list
+
 (** [take_n n l] returns the [n] first elements of [n]. When [compare]
     is provided, it returns the [n] greatest element of [l]. *)
 val take_n: ?compare:('a -> 'a -> int) -> int -> 'a list -> 'a list

src/node/net/p2p.ml

@@ -224,7 +224,7 @@ end
 
 module Fake = struct
 
-  let id = Identity.generate Crypto_box.default_target
+  let id = Identity.generate (Crypto_box.make_target 0.)
   let empty_stat = {
     Stat.total_sent = 0 ;
     total_recv = 0 ;
@@ -261,9 +261,8 @@ type ('msg, 'meta) t = {
 }
 type ('msg, 'meta) net = ('msg, 'meta) t
 
-let bootstrap ~config ~limits meta_cfg msg_cfg =
+let create ~config ~limits meta_cfg msg_cfg =
   Real.create ~config ~limits meta_cfg msg_cfg  >>= fun net ->
-  Real.maintain net () >>= fun () ->
   Lwt.return {
     gid = Real.gid net ;
     maintain = Real.maintain net ;

src/node/net/p2p.mli

@@ -124,7 +124,7 @@ type ('msg, 'meta) net = ('msg, 'meta) t
 val faked_network : ('msg, 'meta) net
 
 (** Main network initialisation function *)
-val bootstrap :
+val create :
   config:config -> limits:limits ->
   'meta meta_config -> 'msg message_config ->  ('msg, 'meta) net Lwt.t
 

src/node/net/p2p_connection.ml

@@ -32,17 +32,53 @@ type error += Rejected
 type error += Decoding_error
 type error += Myself of Id_point.t
 type error += Not_enough_proof_of_work of Gid.t
+type error += Invalid_auth
 
-type cryptobox_data = {
+module Crypto = struct
-  channel_key : Crypto_box.channel_key ;
-  mutable local_nonce : Crypto_box.nonce ;
-  mutable remote_nonce : Crypto_box.nonce ;
-}
 
-let header_length = 2
+  let header_length = 2
-let crypto_overhead = 18 (* FIXME import from Sodium.Box. *)
+  let crypto_overhead = 18 (* FIXME import from Sodium.Box. *)
-let max_content_length =
+  let max_content_length =
-  1 lsl (header_length * 8) - crypto_overhead
+    1 lsl (header_length * 8) - crypto_overhead
+
+  type data = {
+    channel_key : Crypto_box.channel_key ;
+    mutable local_nonce : Crypto_box.nonce ;
+    mutable remote_nonce : Crypto_box.nonce ;
+  }
+
+  let write_chunk fd cryptobox_data buf =
+    let header_buf = MBytes.create header_length in
+    let local_nonce = cryptobox_data.local_nonce in
+    cryptobox_data.local_nonce <- Crypto_box.increment_nonce local_nonce ;
+    let encrypted_message =
+      Crypto_box.fast_box cryptobox_data.channel_key buf local_nonce in
+    let encrypted_len = MBytes.length encrypted_message in
+    fail_unless
+      (encrypted_len < max_content_length)
+      Invalid_message_size >>=? fun () ->
+    MBytes.set_int16 header_buf 0 encrypted_len ;
+    P2p_io_scheduler.write fd header_buf >>=? fun () ->
+    P2p_io_scheduler.write fd encrypted_message >>=? fun () ->
+    return ()
+
+  let read_chunk fd cryptobox_data =
+    let header_buf = MBytes.create header_length in
+    P2p_io_scheduler.read_full ~len:header_length fd header_buf >>=? fun () ->
+    let len = MBytes.get_uint16 header_buf 0 in
+    let buf = MBytes.create len in
+    P2p_io_scheduler.read_full ~len fd buf >>=? fun () ->
+    let remote_nonce = cryptobox_data.remote_nonce in
+    cryptobox_data.remote_nonce <- Crypto_box.increment_nonce remote_nonce ;
+    match
+      Crypto_box.fast_box_open cryptobox_data.channel_key buf remote_nonce
+    with
+    | None ->
+        fail Decipher_error
+    | Some buf ->
+        return buf
+
+end
 
 module Connection_message = struct
 
@@ -78,11 +114,12 @@ module Connection_message = struct
     let encoded_message_len =
       Data_encoding.Binary.length encoding message in
     fail_unless
-      (encoded_message_len < max_content_length)
+      (encoded_message_len < Crypto.max_content_length)
       Encoding_error >>=? fun () ->
-    let len = header_length + encoded_message_len in
+    let len = Crypto.header_length + encoded_message_len in
     let buf = MBytes.create len in
-    match Data_encoding.Binary.write encoding message buf header_length with
+    match Data_encoding.Binary.write
+            encoding message buf Crypto.header_length with
     | None ->
         fail Encoding_error
     | Some last ->
@@ -91,8 +128,9 @@ module Connection_message = struct
         P2p_io_scheduler.write fd buf
 
   let read fd =
-    let header_buf = MBytes.create header_length in
+    let header_buf = MBytes.create Crypto.header_length in
-    P2p_io_scheduler.read_full ~len:header_length fd header_buf >>=? fun () ->
+    P2p_io_scheduler.read_full
+      ~len:Crypto.header_length fd header_buf >>=? fun () ->
     let len = MBytes.get_uint16 header_buf 0 in
     let buf = MBytes.create len in
     P2p_io_scheduler.read_full ~len fd buf >>=? fun () ->
@@ -109,29 +147,25 @@ end
 
 module Ack = struct
 
-  type t = bool
+  type t = Ack | Nack
   let ack = MBytes.of_string "\255"
   let nack = MBytes.of_string "\000"
 
-  let write fd b =
+  let write cryptobox_data fd b =
-    match b with
+    Crypto.write_chunk cryptobox_data fd
-    | true ->
+      (match b with Ack -> ack | Nack -> nack)
-        P2p_io_scheduler.write fd ack
-    | false ->
-        P2p_io_scheduler.write fd nack
 
-  let read fd =
+  let read fd cryptobox_data =
-    let buf = MBytes.create 1 in
+    Crypto.read_chunk fd cryptobox_data >>=? fun buf ->
-    P2p_io_scheduler.read_full fd buf >>=? fun () ->
     return (buf <> nack)
 
 end
 
 type authenticated_fd =
-  P2p_io_scheduler.connection * Connection_info.t * cryptobox_data
+  P2p_io_scheduler.connection * Connection_info.t * Crypto.data
 
-let kick (fd, _ , _) =
+let kick (fd, _ , cryptobox_data) =
-  Ack.write fd false >>= fun _ ->
+  Ack.write fd cryptobox_data Nack >>= fun _ ->
   P2p_io_scheduler.close fd >>= fun _ ->
   Lwt.return_unit
 
@@ -168,14 +202,14 @@ let authenticate
     { Connection_info.gid = remote_gid ; versions = msg.versions ; incoming ;
       id_point ; remote_socket_port ;} in
   let cryptobox_data =
-    { channel_key ; local_nonce ;
+    { Crypto.channel_key ; local_nonce ;
       remote_nonce = msg.message_nonce } in
   return (info, (fd, info, cryptobox_data))
 
 type connection = {
   info : Connection_info.t ;
   fd : P2p_io_scheduler.connection ;
-  cryptobox_data : cryptobox_data ;
+  cryptobox_data : Crypto.data ;
 }
 
 module Reader = struct
@@ -188,29 +222,13 @@ module Reader = struct
     mutable worker: unit Lwt.t ;
   }
 
-  let read_chunk { fd ; cryptobox_data } =
-    let header_buf = MBytes.create header_length in
-    P2p_io_scheduler.read_full ~len:header_length fd header_buf >>=? fun () ->
-    let len = MBytes.get_uint16 header_buf 0 in
-    let buf = MBytes.create len in
-    P2p_io_scheduler.read_full ~len fd buf >>=? fun () ->
-    let remote_nonce = cryptobox_data.remote_nonce in
-    cryptobox_data.remote_nonce <- Crypto_box.increment_nonce remote_nonce ;
-    match
-      Crypto_box.fast_box_open cryptobox_data.channel_key buf remote_nonce
-    with
-    | None ->
-        fail Decipher_error
-    | Some buf ->
-        return buf
-
   let rec read_message st buf =
     return (Data_encoding.Binary.of_bytes st.encoding buf)
 
   let rec worker_loop st =
     Lwt_unix.yield () >>= fun () ->
     Lwt_utils.protect ~canceler:st.canceler begin fun () ->
-      read_chunk st.conn >>=? fun buf ->
+      Crypto.read_chunk st.conn.fd st.conn.cryptobox_data >>=? fun buf ->
       read_message st buf
     end >>= function
     | Ok None ->
@@ -258,21 +276,6 @@ module Writer = struct
     mutable worker: unit Lwt.t ;
   }
 
-  let write_chunk { cryptobox_data ; fd } buf =
-    let header_buf = MBytes.create header_length in
-    let local_nonce = cryptobox_data.local_nonce in
-    cryptobox_data.local_nonce <- Crypto_box.increment_nonce local_nonce ;
-    let encrypted_message =
-      Crypto_box.fast_box cryptobox_data.channel_key buf local_nonce in
-    let encrypted_len = MBytes.length encrypted_message in
-    fail_unless
-      (encrypted_len < max_content_length)
-      Invalid_message_size >>=? fun () ->
-    MBytes.set_int16 header_buf 0 encrypted_len ;
-    P2p_io_scheduler.write fd header_buf >>=? fun () ->
-    P2p_io_scheduler.write fd encrypted_message >>=? fun () ->
-    return ()
-
   let encode_message st msg =
     try return (Data_encoding.Binary.to_bytes st.encoding msg)
     with _ -> fail Encoding_error
@@ -282,7 +285,7 @@ module Writer = struct
     Lwt_utils.protect ~canceler:st.canceler begin fun () ->
       Lwt_pipe.pop st.messages >>= fun (msg, wakener) ->
       encode_message st msg >>=? fun buf ->
-      write_chunk st.conn buf >>= fun res ->
+      Crypto.write_chunk st.conn.fd st.conn.cryptobox_data buf >>= fun res ->
       iter_option wakener ~f:(fun u -> Lwt.wakeup_later u res) ;
       Lwt.return res
     end >>= function
@@ -332,11 +335,14 @@ let accept
     ?incoming_message_queue_size ?outgoing_message_queue_size
     (fd, info, cryptobox_data) encoding =
   Lwt_utils.protect begin fun () ->
-    Ack.write fd true >>=? fun () ->
+    Ack.write fd cryptobox_data Ack >>=? fun () ->
-    Ack.read fd
+    Ack.read fd cryptobox_data
   end ~on_error:begin fun err ->
     P2p_io_scheduler.close fd >>= fun _ ->
-    Lwt.return (Error err)
+    match err with
+    | [ P2p_io_scheduler.Connection_closed ] -> fail Rejected
+    | [ Decipher_error ] -> fail Invalid_auth
+    | err -> Lwt.return (Error err)
   end >>=? fun accepted ->
   fail_unless accepted Rejected >>=? fun () ->
   let canceler = Canceler.create () in

src/node/net/p2p_connection.mli

@@ -26,6 +26,7 @@ type error += Decoding_error
 type error += Rejected
 type error += Myself of Id_point.t
 type error += Not_enough_proof_of_work of Gid.t
+type error += Invalid_auth
 
 type authenticated_fd
 (** Type of a connection that successfully passed the authentication

src/node/net/p2p_connection_pool.ml

@@ -634,16 +634,16 @@ let create config meta_config message_config io_sched =
     events ;
   } in
   List.iter (Points.set_trusted pool) config.trusted_points ;
-  Lwt.catch
+  Gid_info.File.load config.peers_file meta_config.encoding >>= function
-    (fun () ->
+  | Ok gids ->
-       Gid_info.File.load config.peers_file meta_config.encoding)
+      List.iter
-    (fun _ ->
+        (fun gi -> Gid.Table.add pool.known_gids (Gid_info.gid gi) gi)
-       (* TODO log error *)
+        gids ;
-       Lwt.return_nil) >>= fun gids ->
+      Lwt.return pool
-  List.iter
+  | Error err ->
-    (fun gi -> Gid.Table.add pool.known_gids (Gid_info.gid gi) gi)
+      log_error "@[Failed to parsed peers file:@ %a@]"
-    gids ;
+        pp_print_error err ;
-  Lwt.return pool
+      Lwt.return pool
 
 let destroy pool =
   Point.Table.fold (fun _point pi acc ->

src/node/net/p2p_connection_pool_types.ml

@@ -449,9 +449,11 @@ module Gid_info = struct
 
     let load path metadata_encoding =
       let enc = Data_encoding.list (encoding metadata_encoding) in
-      Data_encoding_ezjsonm.read_file path >|=
+      if path <> "/dev/null" && Sys.file_exists path then
-      map_option ~f:(Data_encoding.Json.destruct enc) >|=
+        Data_encoding_ezjsonm.read_file path >>=? fun json ->
-      unopt []
+        return (Data_encoding.Json.destruct enc json)
+      else
+        return []
 
     let save path metadata_encoding peers =
       let open Data_encoding in

src/node/net/p2p_connection_pool_types.mli

@@ -256,10 +256,10 @@ module Gid_info : sig
   module File : sig
     val load :
       string -> 'meta Data_encoding.t ->
-      ('conn, 'meta) gid_info list Lwt.t
+      ('conn, 'meta) gid_info list tzresult Lwt.t
     val save :
       string -> 'meta Data_encoding.t ->
-      ('conn, 'meta) gid_info list -> bool Lwt.t
+      ('conn, 'meta) gid_info list -> unit tzresult Lwt.t
   end
 
 end

src/node/net/p2p_io_scheduler.ml

@@ -147,7 +147,7 @@ module Scheduler(IO : IO) = struct
       canceler = Canceler.create () ;
       worker = Lwt.return_unit ;
       counter = Moving_average.create ~init:0 ~alpha ;
-      max_speed ; quota = unopt 0 max_speed ;
+      max_speed ; quota = unopt ~default:0 max_speed ;
       quota_updated = Lwt_condition.create () ;
       readys = Lwt_condition.create () ;
       readys_high = Queue.create () ;
@@ -358,9 +358,9 @@ let write_now { write_queue } msg = Lwt_pipe.push_now write_queue msg
 
 let read_from conn ?pos ?len buf msg =
   let maxlen = MBytes.length buf in
-  let pos = unopt 0 pos in
+  let pos = unopt ~default:0 pos in
   assert (0 <= pos && pos < maxlen) ;
-  let len = unopt (maxlen - pos) len in
+  let len = unopt ~default:(maxlen - pos) len in
   assert (len <= maxlen - pos) ;
   match msg with
   | Ok msg ->
@@ -400,8 +400,8 @@ let read conn ?pos ?len buf =
 
 let read_full conn ?pos ?len buf =
   let maxlen = MBytes.length buf in
-  let pos = unopt 0 pos in
+  let pos = unopt ~default:0 pos in
-  let len = unopt (maxlen - pos) len in
+  let len = unopt ~default:(maxlen - pos) len in
   assert (0 <= pos && pos < maxlen) ;
   assert (len <= maxlen - pos) ;
   let rec loop pos len =

src/node/net/p2p_maintenance.ml

@@ -79,6 +79,7 @@ let rec try_to_contact
     let contactable =
       connectable st start_time max_to_contact in
     if contactable = [] then
+      Lwt_unix.yield () >>= fun () ->
       Lwt.return_false
     else
       List.fold_left
@@ -111,11 +112,11 @@ let rec maintain st =
 and too_few_connections st n_connected =
   let Pool pool = st.pool in
   (* too few connections, try and contact many peers *)
-  lwt_debug "Too few connections (%d)" n_connected >>= fun () ->
+  lwt_log_notice "Too few connections (%d)" n_connected >>= fun () ->
   let min_to_contact = st.bounds.min_target - n_connected in
   let max_to_contact = st.bounds.max_target - n_connected in
-  try_to_contact st min_to_contact max_to_contact >>= fun continue ->
+  try_to_contact st min_to_contact max_to_contact >>= fun success ->
-  if not continue then begin
+  if success then begin
     maintain st
   end else begin
     (* not enough contacts, ask the pals of our pals,

src/node/net/p2p_types.ml

@@ -193,12 +193,55 @@ module Identity = struct
          (req "secret_key" Crypto_box.secret_key_encoding)
          (req "proof_of_work_stamp" Crypto_box.nonce_encoding))
 
-  let generate target =
+  let generate ?max target =
     let secret_key, public_key, gid = Crypto_box.random_keypair () in
     let proof_of_work_stamp =
-      Crypto_box.generate_proof_of_work public_key target in
+      Crypto_box.generate_proof_of_work ?max public_key target in
     { gid ; public_key ; secret_key ; proof_of_work_stamp }
 
+  let animation = [|
+    "|.....|" ;
+    "|o....|" ;
+    "|oo...|" ;
+    "|ooo..|" ;
+    "|.ooo.|" ;
+    "|..ooo|" ;
+    "|...oo|" ;
+    "|....o|" ;
+    "|.....|" ;
+    "|.....|" ;
+    "|.....|" ;
+    "|.....|" ;
+  |]
+
+  let init = String.make (String.length animation.(0)) '\ '
+  let clean = String.make (String.length animation.(0)) '\b'
+  let animation = Array.map (fun x -> clean ^ x) animation
+  let animation_size = Array.length animation
+  let duration = 1200 / animation_size
+
+  let generate_with_animation ppf target =
+    Format.fprintf ppf "%s%!" init ;
+    let count = ref 10000 in
+    let rec loop n =
+      let start = Mtime.counter () in
+      Format.fprintf ppf "%s%!" animation.(n mod animation_size);
+      try generate ~max:!count target
+      with Not_found ->
+        let time = Mtime.to_ms (Mtime.count start) in
+        count :=
+          if time <= 0. then
+            !count * 10
+          else
+            !count * duration / int_of_float time ;
+        loop (n+1)
+    in
+    let id = loop 0 in
+    Format.fprintf ppf "%s%s\n%!" clean init ;
+    id
+
+  let generate target = generate target
+
 end
 
 module Connection_info = struct

src/node/net/p2p_types.mli

@@ -94,6 +94,12 @@ module Identity : sig
   val generate : Crypto_box.target -> t
   (** [generate target] is a freshly minted identity whose proof of
       work stamp difficulty is at least equal to [target]. *)
+
+  val generate_with_animation :
+    Format.formatter -> Crypto_box.target -> t
+  (** [generate_with_animation ppf target] is a freshly minted identity
+      whose proof of work stamp difficulty is at least equal to [target]. *)
+
 end
 
 

src/node/shell/node.ml

@@ -211,10 +211,21 @@ let init_p2p net_params =
       Lwt.return Tezos_p2p.faked_network
   | Some (config, limits) ->
       lwt_log_notice "bootstraping network..." >>= fun () ->
-      Tezos_p2p.bootstrap config limits
+      Tezos_p2p.create config limits >>= fun p2p ->
+      Lwt.async (fun () -> Tezos_p2p.maintain p2p) ;
+      Lwt.return p2p
 
-let create
+type config = {
-    ~genesis ~store_root ~context_root ?test_protocol ?patch_context net_params =
+  genesis: Store.genesis ;
+  store_root: string ;
+  context_root: string ;
+  test_protocol: Protocol_hash.t option ;
+  patch_context: (Context.t -> Context.t Lwt.t) option ;
+  p2p: (P2p.config * P2p.limits) option ;
+}
+
+let create { genesis ; store_root ; context_root ;
+             test_protocol ; patch_context ; p2p = net_params } =
   lwt_debug "-> Node.create" >>= fun () ->
   init_p2p net_params >>= fun p2p ->
   lwt_log_info "reading state..." >>= fun () ->
@@ -234,11 +245,12 @@ let create
   end >>=? fun global_net ->
   Validator.activate validator global_net >>= fun global_validator ->
   let cleanup () =
+    Tezos_p2p.shutdown p2p >>= fun () ->
     Lwt.join [ Validator.shutdown validator ;
                Discoverer.shutdown discoverer ] >>= fun () ->
     State.store state
   in
-
+  let canceler = Lwt_utils.Canceler.create () in
   lwt_log_info "starting worker..." >>= fun () ->
   let worker =
     let handle_msg peer msg =
@@ -249,22 +261,23 @@ let create
       Lwt.return_unit
     in
     let rec worker_loop () =
-      Tezos_p2p.recv p2p >>= fun (peer, msg) ->
+      Lwt_utils.protect ~canceler begin fun () ->
+        Tezos_p2p.recv p2p >>= return
+      end >>=? fun (peer, msg) ->
       handle_msg peer msg >>= fun () ->
       worker_loop () in
-    Lwt.catch
+    worker_loop () >>= function
-      worker_loop
+    | Error [Lwt_utils.Canceled] | Ok () ->
-      (function
+        cleanup ()
-        | Queue.Empty -> cleanup ()
+    | Error err ->
-        | exn ->
+        lwt_log_error
-            lwt_log_error "unexpected exception in worker\n%s"
+          "@[Unexpected error in worker@ %a@]"
-              (Printexc.to_string exn) >>= fun () ->
+          pp_print_error err >>= fun () ->
-            Tezos_p2p.shutdown p2p >>= fun () ->
+        cleanup ()
-            cleanup ())
   in
   let shutdown () =
     lwt_log_info "stopping worker..." >>= fun () ->
-    Tezos_p2p.shutdown p2p >>= fun () ->
+    Lwt_utils.Canceler.cancel canceler >>= fun () ->
     worker >>= fun () ->
     lwt_log_info "stopped"
   in

src/node/shell/node.mli

@@ -9,14 +9,16 @@
 
 type t
 
-val create:
+type config = {
-  genesis:Store.genesis ->
+  genesis: Store.genesis ;
-  store_root:string ->
+  store_root: string ;
-  context_root:string ->
+  context_root: string ;
-  ?test_protocol:Protocol_hash.t ->
+  test_protocol: Protocol_hash.t option ;
-  ?patch_context:(Context.t -> Context.t Lwt.t) ->
+  patch_context: (Context.t -> Context.t Lwt.t) option ;
-  (P2p.config * P2p.limits) option ->
+  p2p: (P2p.config * P2p.limits) option ;
-  t tzresult Lwt.t
+}
+
+val create: config -> t tzresult Lwt.t
 
 module RPC : sig
 

src/node/shell/node_rpc.ml

@@ -394,9 +394,9 @@ let build_rpc_directory node =
   let dir =
     let implementation (net_id, pred, time, fitness, operations, header) =
       Node.RPC.block_info node (`Head 0) >>= fun bi ->
-      let timestamp = Utils.unopt (Time.now ()) time in
+      let timestamp = Utils.unopt ~default:(Time.now ()) time in
-      let net_id = Utils.unopt bi.net net_id in
+      let net_id = Utils.unopt ~default:bi.net net_id in
-      let predecessor = Utils.unopt bi.hash pred in
+      let predecessor = Utils.unopt ~default:bi.hash pred in
       let res =
         Store.Block.to_bytes {
           shell = { net_id ; predecessor ; timestamp ; fitness ; operations } ;

src/node/shell/node_rpc_services.ml

@@ -524,7 +524,7 @@ let inject_block =
          (fun (block, blocking, force) ->
             (block, Some blocking, force))
          (fun (block, blocking, force) ->
-            (block, Utils.unopt true blocking, force))
+            (block, Utils.unopt ~default:true blocking, force))
          (obj3
             (req "data" bytes)
             (opt "blocking"
@@ -555,25 +555,23 @@ let inject_operation =
        RPCs ubder /blocks/prevalidation for more details on the \
        prevalidation context."
     ~input:
-      (conv
+      (obj3
-         (fun (block, blocking, force) -> (block, Some blocking, force))
+         (req "signedOperationContents"
-         (fun (block, blocking, force) -> (block, unopt true blocking, force))
+            (describe ~title: "Tezos signed operation (hex encoded)"
-         (obj3
+               bytes))
-            (req "signedOperationContents"
+         (dft "blocking"
-               (describe ~title: "Tezos signed operation (hex encoded)"
+            (describe
-                  bytes))
+               ~description:
-            (opt "blocking"
+                 "Should the RPC wait for the operation to be \
-               (describe
+                  (pre-)validated before to answer. (default: true)"
-                  ~description:
+               bool)
-                    "Should the RPC wait for the operation to be \
+            true)
-                     (pre-)validated before to answer. (default: true)"
+         (opt "force"
-                  bool))
+            (describe
-            (opt "force"
+               ~description:
-               (describe
+                 "Should we inject operation that are \"branch_refused\" \
-                  ~description:
+                  or \"branch_delayed\". (default: false)"
-                    "Should we inject operation that are \"branch_refused\" \
+               bool)))
-                     or \"branch_delayed\". (default: false)"
-                  bool))))
     ~output:
       (Error.wrap @@
        describe
@@ -582,21 +580,6 @@ let inject_operation =
     RPC.Path.(root / "inject_operation")
 
 let inject_protocol =
-  let proto =
-    (list
-       (obj3
-          (req "name"
-             (describe ~title:"OCaml module name"
-                string))
-          (opt "interface"
-             (describe
-                ~description:"Content of the .mli file"
-                string))
-          (req "implementation"
-             (describe
-                ~description:"Content of the .ml file"
-                string))))
-  in
   let proto_of_rpc =
     List.map (fun (name, interface, implementation) ->
         { Tezos_compiler.Protocol.name; interface; implementation })
@@ -605,28 +588,44 @@ let inject_protocol =
     List.map (fun { Tezos_compiler.Protocol.name; interface; implementation } ->
                 (name, interface, implementation))
   in
+  let proto =
+    conv
+      rpc_of_proto
+      proto_of_rpc
+      (list
+         (obj3
+            (req "name"
+               (describe ~title:"OCaml module name"
+                  string))
+            (opt "interface"
+               (describe
+                  ~description:"Content of the .mli file"
+                  string))
+            (req "implementation"
+               (describe
+                  ~description:"Content of the .ml file"
+                  string))))
+  in
   RPC.service
     ~description:
       "Inject a protocol in node. Returns the ID of the protocol."
     ~input:
-      (conv
+      (obj3
-         (fun (proto, blocking, force) -> (rpc_of_proto proto, Some blocking, force))
+         (req "protocol"
-         (fun (proto, blocking, force) -> (proto_of_rpc proto, unopt true blocking, force))
+            (describe ~title: "Tezos protocol"
-         (obj3
+               proto))
-            (req "protocol"
+         (dft "blocking"
-               (describe ~title: "Tezos protocol"
+            (describe
-                  proto))
+               ~description:
-            (opt "blocking"
+                 "Should the RPC wait for the protocol to be \
-               (describe
+                  validated before to answer. (default: true)"
-                  ~description:
+               bool)
-                    "Should the RPC wait for the protocol to be \
+            true)
-                     validated before to answer. (default: true)"
+         (opt "force"
-                  bool))
+            (describe
-            (opt "force"
+               ~description:
-               (describe
+                 "Should we inject protocol that is invalid. (default: false)"
-                  ~description:
+               bool)))
-                    "Should we inject protocol that is invalid. (default: false)"
-                  bool))))
     ~output:
       (Error.wrap @@
        describe

src/node/shell/state.ml

@@ -699,7 +699,8 @@ module Valid_block = struct
           (* TODO check coherency: test_protocol. *)
           Lwt.return res
       | None ->
-          let test_protocol = Utils.unopt genesis.protocol test_protocol in
+          let test_protocol =
+            Utils.unopt ~default:genesis.protocol test_protocol in
           Context.create_genesis_context
             vstate.index genesis test_protocol >>= fun _context ->
           Block.db_store vstate.block_db genesis.block {

src/node/shell/tezos_p2p.ml

@@ -106,8 +106,8 @@ and msg_cfg : _ P2p.message_config = {
 
 type net = (Message.t, Metadata.t) P2p.net
 
-let bootstrap ~config ~limits =
+let create ~config ~limits =
-  P2p.bootstrap ~config ~limits meta_cfg msg_cfg
+  P2p.create ~config ~limits meta_cfg msg_cfg
 
 let broadcast = P2p.broadcast
 let try_send = P2p.try_send

src/node/shell/tezos_p2p.mli

@@ -8,7 +8,7 @@ type net
 val faked_network : net
 
 (** Main network initialisation function *)
-val bootstrap : config:config -> limits:limits -> net Lwt.t
+val create : config:config -> limits:limits -> net Lwt.t
 
 (** A maintenance operation : try and reach the ideal number of peers *)
 val maintain : net -> unit Lwt.t

src/utils/crypto_box.ml

@@ -15,7 +15,7 @@ type secret_key = Sodium.Box.secret_key
 type public_key = Sodium.Box.public_key
 type channel_key = Sodium.Box.channel_key
 type nonce = Sodium.Box.nonce
-type target = int64 list (* used as unsigned intergers... *)
+type target = Z.t
 exception TargetNot256Bit
 
 module Public_key_hash = Hash.Make_Blake2B (Base48) (struct
@@ -44,24 +44,29 @@ let fast_box_open ck msg nonce =
   try Some (Sodium.Box.Bigbytes.fast_box_open ck msg nonce) with
     | Sodium.Verification_failure -> None
 
-let make_target target =
-  if List.length target > 8 then raise TargetNot256Bit ;
-  target
-
-(* Compare a SHA256 hash to a 256bits-target prefix.
-   The prefix is a list of "unsigned" int64. *)
 let compare_target hash target =
-  let hash = Hash.Generic_hash.to_string hash in
+  let hash = Z.of_bits (Hash.Generic_hash.to_string hash) in
-  let rec check offset = function
+  Z.compare hash target <= 0
-    | [] -> true
-    | x :: xs ->
-        Compare.Uint64.(EndianString.BigEndian.get_int64 hash offset <= x)
-        && check (offset + 8) xs in
-  check 0 target
 
-let default_target =
+let make_target f =
-  (* FIXME we use an easy target until we allow custom configuration. *)
+  if f < 0. || 256. < f then invalid_arg "Cryptobox.target_of_float" ;
-  [ Int64.shift_left 1L 48 ]
+  let frac, shift = modf f in
+  let shift = int_of_float shift in
+  let m =
+    Z.of_int64 @@
+    if frac = 0. then
+      Int64.(pred (shift_left 1L 54))
+    else
+      Int64.of_float (2. ** (54. -. frac))
+  in
+  if shift < 202 then
+    Z.logor
+      (Z.shift_left m (202 - shift))
+      (Z.pred @@ Z.shift_left Z.one (202 - shift))
+  else
+    Z.shift_right m (shift - 202)
+
+let default_target = make_target 24.
 
 let check_proof_of_work pk nonce target =
   let hash =
@@ -71,11 +76,18 @@ let check_proof_of_work pk nonce target =
     ] in
   compare_target hash target
 
-let generate_proof_of_work pk target =
+let generate_proof_of_work ?max pk target =
-  let rec loop nonce =
+  let may_interupt =
-    if check_proof_of_work pk nonce target then nonce
+    match max with
-    else loop (increment_nonce nonce) in
+    | None -> (fun _ -> ())
-  loop (random_nonce ())
+    | Some max -> (fun cpt -> if max < cpt then raise Not_found) in
+  let rec loop nonce cpt =
+    may_interupt cpt ;
+    if check_proof_of_work pk nonce target then
+      nonce
+    else
+      loop (increment_nonce nonce) (cpt + 1) in
+  loop (random_nonce ()) 0
 
 let public_key_encoding =
   let open Data_encoding in

src/utils/crypto_box.mli

@@ -16,8 +16,8 @@ val increment_nonce : ?step:int -> nonce -> nonce
 val nonce_encoding : nonce Data_encoding.t
 
 type target
-val make_target : (* unsigned *) Int64.t list -> target
 val default_target : target
+val make_target : float -> target
 
 type secret_key
 type public_key
@@ -38,5 +38,5 @@ val fast_box        : channel_key -> MBytes.t -> nonce -> MBytes.t
 val fast_box_open   : channel_key -> MBytes.t -> nonce -> MBytes.t option
 
 val check_proof_of_work : public_key -> nonce -> target -> bool
-val generate_proof_of_work : public_key -> target -> nonce
+val generate_proof_of_work : ?max:int -> public_key -> target -> nonce
 

src/utils/data_encoding_ezjsonm.ml

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Error_monad
+
 let to_root = function
   | `O ctns -> `O ctns
   | `A ctns -> `A ctns
@@ -35,22 +37,21 @@ let from_stream (stream: string Lwt_stream.t) =
 
 let write_file file json =
   let json = to_root json in
-  let open Lwt in
+  protect begin fun () ->
-  catch
+    Lwt_io.with_file ~mode:Output file begin fun chan ->
-    (fun () ->
+      let str = to_string json in
-       Lwt_io.(with_file ~mode:Output file (fun chan ->
+      Lwt_io.write chan str >>= fun _ ->
-           let str = to_string json in
+      return ()
-           write chan str >>= fun _ ->
+    end
-           return true)))
+  end
-    (fun _ -> return false)
 
 let read_file file =
-  let open Lwt in
+  protect begin fun () ->
-  catch
+    Lwt_io.with_file ~mode:Input file begin fun chan ->
-    (fun () ->
+      Lwt_io.read chan >>= fun str ->
-       Lwt_io.(with_file ~mode:Input file (fun chan ->
+      return (Ezjsonm.from_string str :> Data_encoding.json)
-           read chan >>= fun str ->
+    end
-           return (Some (Ezjsonm.from_string str :> Data_encoding.json)))))
+  end
-    (fun _ ->
+
-       (* TODO log error or use Error_monad. *)
+let () =
-       return None)
+  Error_monad.json_to_string := to_string

src/utils/data_encoding_ezjsonm.mli

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Error_monad
+
 (** Read a JSON document from a string. *)
 val from_string : string -> (Data_encoding.json, string) result
 
@@ -20,7 +22,7 @@ val from_stream : string Lwt_stream.t -> (Data_encoding.json, string) result Lwt
 val to_string : Data_encoding.json -> string
 
 (** Loads a JSON file in memory *)
-val read_file : string -> Data_encoding.json option Lwt.t
+val read_file : string -> Data_encoding.json tzresult Lwt.t
 
 (** (Over)write a JSON file from in memory data *)
-val write_file : string -> Data_encoding.json -> bool Lwt.t
+val write_file : string -> Data_encoding.json -> unit tzresult Lwt.t

src/utils/error_monad.ml

@@ -16,12 +16,15 @@ type error_category = [ `Branch | `Temporary | `Permanent ]
 type 'err full_error_category =
   [ error_category | `Wrapped of 'err -> error_category ]
 
+(* HACK: forward reference from [Data_encoding_ezjsonm] *)
+let json_to_string = ref (fun _ -> "")
+
 let json_pp id encoding ppf x =
+  Format.pp_print_string ppf @@
+  !json_to_string @@
   let encoding =
     Data_encoding.(merge_objs (obj1 (req "id" string)) encoding) in
-  Format.pp_print_string ppf @@
+  Data_encoding.Json.construct encoding (id, x)
-  Data_encoding_ezjsonm.to_string @@
-  Data_encoding.Json.(construct encoding (id, x))
 
 module Make() = struct
 
@@ -76,7 +79,7 @@ module Make() = struct
                    category ;
                    from_error ;
                    encoding_case ;
-                   pp = Utils.unopt (json_pp name encoding) pp } :: !error_kinds
+                   pp = Utils.unopt ~default:(json_pp name encoding) pp } :: !error_kinds
 
   let register_wrapped_error_kind
       category ~id ~title ~description ?pp
@@ -176,11 +179,6 @@ module Make() = struct
 
   let fail s = Lwt.return (Error [ s ])
 
-  let protect ~on_error t =
-    t >>= function
-    | Ok res -> return res
-    | Error err -> on_error err
-
   let (>>?) v f =
     match v with
     | Error _ as err -> err
@@ -327,6 +325,11 @@ let () =
   error_kinds :=
     Error_kind { id; from_error ; category; encoding_case ; pp } :: !error_kinds
 
+let protect ~on_error t =
+  t  >>= function
+  | Ok res -> return res
+  | Error err -> on_error err
+
 end
 
 include Make()
@@ -342,6 +345,14 @@ let error_exn s = Error [ Exn s ]
 let trace_exn exn f = trace (Exn exn) f
 let record_trace_exn exn f = record_trace (Exn exn) f
 
+let protect ?on_error t =
+  Lwt.catch t (fun exn -> fail (Exn exn)) >>= function
+  | Ok res -> return res
+  | Error err ->
+      match on_error with
+      | Some f -> f err
+      | None -> Lwt.return (Error err)
+
 let pp_exn ppf exn = pp ppf (Exn exn)
 
 let () =

src/utils/error_monad.mli

@@ -26,6 +26,10 @@ val failwith :
   ('a, Format.formatter, unit, 'b tzresult Lwt.t) format4 ->
   'a
 
+val protect :
+  ?on_error: (error list -> 'a tzresult Lwt.t) ->
+  (unit -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t
+
 val error_exn : exn -> 'a tzresult
 val record_trace_exn : exn -> 'a tzresult -> 'a tzresult
 val trace_exn : exn -> 'b tzresult Lwt.t -> 'b tzresult Lwt.t
@@ -35,3 +39,6 @@ type error += Exn of exn
 type error += Unclassified of string
 
 module Make() : Error_monad_sig.S
+
+(**/**)
+val json_to_string : (Data_encoding.json -> string) ref

src/utils/logging.ml

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Lwt.Infix
+
 module type LOG = sig
 
   val debug: ('a, Format.formatter, unit, unit) format4 -> 'a
@@ -86,32 +88,134 @@ module Client = struct
 end
 module Webclient = Make(struct let name = "webclient" end)
 
-let template = "$(date) $(name)[$(pid)]: $(message)"
+type template = Lwt_log.template
-
+let default_template = "$(date) - $(section): $(message)"
-let default_logger () =
-  Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr ()
 
 type kind =
   | Null
   | Stdout
   | Stderr
   | File of string
-  | Syslog
+  | Syslog of Lwt_log.syslog_facility
-  | Manual of Lwt_log.logger
 
-let init kind =
+let kind_encoding =
-  let logger =
+  let open Data_encoding in
+  conv
+    (function
+      | Null -> "/dev/null"
+      | Stdout -> "stdout"
+      | Stderr -> "stderr"
+      | File fp -> fp
+      | Syslog `Auth -> "syslog:auth"
+      | Syslog `Authpriv -> "syslog:authpriv"
+      | Syslog `Cron -> "syslog:cron"
+      | Syslog `Daemon -> "syslog:daemon"
+      | Syslog `FTP -> "syslog:ftp"
+      | Syslog `Kernel -> "syslog:kernel"
+      | Syslog `Local0 -> "syslog:local0"
+      | Syslog `Local1 -> "syslog:local1"
+      | Syslog `Local2 -> "syslog:local2"
+      | Syslog `Local3 -> "syslog:local3"
+      | Syslog `Local4 -> "syslog:local4"
+      | Syslog `Local5 -> "syslog:local5"
+      | Syslog `Local6 -> "syslog:local6"
+      | Syslog `Local7 -> "syslog:local7"
+      | Syslog `LPR -> "syslog:lpr"
+      | Syslog `Mail -> "syslog:mail"
+      | Syslog `News -> "syslog:news"
+      | Syslog `Syslog -> "syslog:syslog"
+      | Syslog `User -> "syslog:user"
+      | Syslog `UUCP -> "syslog:uucp"
+      | Syslog `NTP -> "syslog:ntp"
+      | Syslog `Security -> "syslog:security"
+      | Syslog `Console -> "syslog:console")
+    (function
+      | "/dev/null" | "null" -> Null
+      | "stdout" -> Stdout
+      | "stderr" -> Stderr
+      | "syslog:auth" -> Syslog `Auth
+      | "syslog:authpriv" -> Syslog `Authpriv
+      | "syslog:cron" -> Syslog `Cron
+      | "syslog:daemon" -> Syslog `Daemon
+      | "syslog:ftp" -> Syslog `FTP
+      | "syslog:kernel" -> Syslog `Kernel
+      | "syslog:local0" -> Syslog `Local0
+      | "syslog:local1" -> Syslog `Local1
+      | "syslog:local2" -> Syslog `Local2
+      | "syslog:local3" -> Syslog `Local3
+      | "syslog:local4" -> Syslog `Local4
+      | "syslog:local5" -> Syslog `Local5
+      | "syslog:local6" -> Syslog `Local6
+      | "syslog:local7" -> Syslog `Local7
+      | "syslog:lpr" -> Syslog `LPR
+      | "syslog:mail" -> Syslog `Mail
+      | "syslog:news" -> Syslog `News
+      | "syslog:syslog" -> Syslog `Syslog
+      | "syslog:user" -> Syslog `User
+      | "syslog:uucp" -> Syslog `UUCP
+      | "syslog:ntp" -> Syslog `NTP
+      | "syslog:security" -> Syslog `Security
+      | "syslog:console" -> Syslog `Console
+      (* | s when start_with "syslog:" FIXME error or warning. *)
+      | fp ->
+          (* TODO check absolute path *)
+          File fp)
+    string
+
+
+let init ?(template = default_template) kind =
+  begin
     match kind with
     | Stderr ->
-        default_logger ()
+        Lwt.return @@
+        Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr ()
     | Stdout ->
+        Lwt.return @@
         Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stdout ()
     | File file_name ->
-        Lwt_main.run (Lwt_log.file ~file_name ~template ())
+        Lwt_log.file ~file_name ~template ()
     | Null ->
+        Lwt.return @@
         Lwt_log.null
-    | Syslog ->
+    | Syslog facility ->
-        Printf.eprintf "Warning: log_kind \"syslog\" not yet implemented.\n%!";
+        Lwt.return @@
-        default_logger ()
+        Lwt_log.syslog ~template ~facility ()
-    | Manual logger -> logger in
+  end >>= fun logger ->
-  Lwt_log.default := logger
+  Lwt_log.default := logger ;
+  Lwt.return_unit
+
+type level = Lwt_log_core.level =
+  | Debug
+      (** Debugging message. They can be automatically removed by the
+          syntax extension. *)
+  | Info
+      (** Informational message. Suitable to be displayed when the
+          program is in verbose mode. *)
+  | Notice
+      (** Same as {!Info}, but is displayed by default. *)
+  | Warning
+      (** Something strange happend *)
+  | Error
+      (** An error message, which should not means the end of the
+          program. *)
+  | Fatal
+
+let level_encoding =
+  let open Data_encoding in
+  conv
+    (function
+      | Fatal -> "fatal"
+      | Error -> "error"
+      | Warning -> "warning"
+      | Notice -> "notice"
+      | Info -> "info"
+      | Debug -> "debug")
+    (function
+      | "error" -> Error
+      | "warn" -> Warning
+      | "notice" -> Notice
+      | "info" -> Info
+      | "debug" -> Debug
+      | "fatal" -> Fatal
+      | _ -> invalid_arg "Logging.level")
+    string

src/utils/logging.mli

@@ -48,12 +48,34 @@ module Webclient : LOG
 
 module Make(S: sig val name: string end) : LOG
 
+type level = Lwt_log_core.level =
+  | Debug
+      (** Debugging message. They can be automatically removed by the
+          syntax extension. *)
+  | Info
+      (** Informational message. Suitable to be displayed when the
+          program is in verbose mode. *)
+  | Notice
+      (** Same as {!Info}, but is displayed by default. *)
+  | Warning
+      (** Something strange happend *)
+  | Error
+      (** An error message, which should not means the end of the
+          program. *)
+  | Fatal
+
+type template = Lwt_log.template
+val default_template : template
+
+val level_encoding : level Data_encoding.t
+
 type kind =
   | Null
   | Stdout
   | Stderr
   | File of string
-  | Syslog
+  | Syslog of Lwt_log.syslog_facility
-  | Manual of Lwt_log.logger
 
-val init: kind -> unit
+val kind_encoding : kind Data_encoding.t
+
+val init: ?template:template -> kind -> unit Lwt.t

src/utils/lwt_utils.ml

@@ -346,12 +346,14 @@ let remove_dir dir =
     Lwt.return ()
 
 let rec create_dir ?(perm = 0o755) dir =
-  if Sys.file_exists dir then
+  Lwt_unix.file_exists dir >>= function
-    Lwt.return ()
+  | false ->
-  else begin
+      create_dir (Filename.dirname dir) >>= fun () ->
-    create_dir (Filename.dirname dir) >>= fun () ->
+      Lwt_unix.mkdir dir perm
-    Lwt_unix.mkdir dir perm
+  | true ->
-  end
+      Lwt_unix.stat dir >>= function
+      | {st_kind = S_DIR} -> Lwt.return_unit
+      | _ -> failwith "Not a directory"
 
 let create_file ?(perm = 0o644) name content =
   Lwt_unix.openfile name Unix.([O_TRUNC; O_CREAT; O_WRONLY]) perm >>= fun fd ->
@@ -402,4 +404,6 @@ let with_timeout ?(canceler = Canceler.create ()) timeout f =
       Canceler.cancel canceler >>= fun () ->
       fail Timeout
 
+let unless cond f =
+  if cond then Lwt.return () else f ()
 

src/utils/lwt_utils.mli

@@ -67,3 +67,5 @@ val with_timeout:
   ?canceler:Canceler.t ->
   float -> (Canceler.t -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t
 
+val unless: bool -> (unit -> unit Lwt.t) -> unit Lwt.t
+

test/lib/assert.ml

@@ -14,6 +14,16 @@ include Kaputt.Assertion
 
 let format_msg = function None -> None | Some msg -> Some (msg ^ "\n")
 
+let is_error ?(msg="") x =
+  match x with
+  | Error _ -> ()
+  | Ok _ -> fail "Error _" "Ok _" msg
+
+let is_ok ?(msg="") x =
+  match x with
+  | Ok _ -> ()
+  | Error _ -> fail "Ok _" "Error _" msg
+
 let equal_persist_list ?msg l1 l2 =
   let msg = format_msg msg in
   let pr_persist l =

test/lib/assert.mli

@@ -8,8 +8,12 @@
 (**************************************************************************)
 
 open Hash
+open Error_monad
 include (module type of struct include Kaputt.Assertion end)
 
+val is_ok : ?msg:string -> 'a tzresult -> unit
+val is_error : ?msg:string -> 'a tzresult -> unit
+
 val fail_msg : ('a, Format.formatter, unit, 'b) format4 -> 'a
 
 val fail : string -> string -> ('a, Format.formatter, unit, 'b) format4 -> 'a

test/lib/process.ml

@@ -19,11 +19,8 @@ let detach ?(prefix = "") f =
   | 0 ->
       Random.self_init () ;
       let template = Format.asprintf "%s$(section): $(message)" prefix in
-      let logger =
-        Lwt_log.channel
-          ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () in
-      Logging.init (Manual logger) ;
       Lwt_main.run begin
+        Logging.init ~template Stderr >>= fun () ->
         lwt_log_notice "PID: %d" (Unix.getpid ()) >>= fun () ->
         f ()
       end ;

test/test-basic.sh

@@ -5,8 +5,8 @@ set -e
 DIR=$(dirname "$0")
 cd "${DIR}"
 
-DATA_DIR=$(mktemp -d /tmp/tezos_node.XXXXXXXXXX)
+DATA_DIR="$(mktemp -td tezos_node.XXXXXXXXXX)"
-CLIENT_DIR=$(mktemp -d /tmp/tezos_client.XXXXXXXXXX)
+CLIENT_DIR="$(mktemp -td tezos_client.XXXXXXXXXX)"
 
 cleanup() {
     rm -fr ${DATA_DIR} ${CLIENT_DIR}
@@ -17,8 +17,8 @@ trap cleanup EXIT QUIT INT
 NODE=../tezos-node
 CLIENT="../tezos-client -base-dir ${CLIENT_DIR}"
 
-CUSTOM_PARAM="--sandbox-param ./sandbox.json"
+CUSTOM_PARAM="--sandbox ./sandbox.json"
-${NODE} --sandbox "${DATA_DIR}" ${CUSTOM_PARAM} --rpc-addr :::8732 > LOG 2>&1 &
+${NODE} --base-dir "${DATA_DIR}" ${CUSTOM_PARAM} --rpc-addr :::8732 > LOG 2>&1 &
 NODE_PID="$!"
 
 sleep 3

test/test_basic.ml

@@ -50,8 +50,8 @@ let fork_node () =
     Unix.create_process
       Filename.(concat (dirname (Sys.getcwd ())) "tezos-node")
       [| "tezos-node" ;
-         "--sandbox"; data_dir ;
+         "--base-dir"; data_dir ;
-         "--sandbox-param"; "./sandbox.json";
+         "--sandbox"; "./sandbox.json";
          "--rpc-addr"; ":::8732" |]
       null_fd log_fd log_fd in
   Printf.printf "Created node, pid: %d, log: %s\n%!" pid log_file_name ;

test/test_data_encoding.ml

@@ -110,11 +110,11 @@ let test_json testdir =
   let f_str = to_string v in
   Assert.equal_string  ~msg:__LOC__ f_str "[\n  42\n]";
   read_file (testdir // "NONEXISTINGFILE") >>= fun rf ->
-  Assert.is_none ~msg:__LOC__ rf;
+  Assert.is_error ~msg:__LOC__ rf ;
   write_file file v >>= fun success ->
-  Assert.is_true ~msg:__LOC__ success;
+  Assert.is_ok ~msg:__LOC__ success ;
   read_file file >>= fun opt ->
-  Assert.is_some ~msg:__LOC__ opt;
+  Assert.is_ok ~msg:__LOC__ opt ;
   Lwt.return ()
 
 type t = A of int | B of string | C of int | D of string | E
@@ -269,8 +269,8 @@ let test_json_input testdir =
 |}
     in
     Data_encoding_ezjsonm.read_file file >>= function
-      None -> Assert.fail_msg "Cannot parse \"good.json\"."
+    | Error _ -> Assert.fail_msg "Cannot parse \"good.json\"."
-    | Some json ->
+    | Ok json ->
         let (id, value, popup) = Json.destruct enc json in
         Assert.equal_string ~msg:__LOC__ "file" id;
         Assert.equal_string ~msg:__LOC__ "File" value;
@@ -295,8 +295,8 @@ let test_json_input testdir =
 |}
     in
     Data_encoding_ezjsonm.read_file file >>= function
-      None -> Assert.fail_msg "Cannot parse \"unknown.json\"."
+    | Error _ -> Assert.fail_msg "Cannot parse \"unknown.json\"."
-    | Some json ->
+    | Ok json ->
         Assert.test_fail ~msg:__LOC__
           (fun () -> ignore (Json.destruct enc json))
           (function

test/test_p2p_connection.ml

@@ -14,14 +14,13 @@ open Error_monad
 open P2p_types
 include Logging.Make (struct let name = "test-p2p-connection" end)
 
-let proof_of_work_target =
+let proof_of_work_target = Crypto_box.make_target 16.
-  Crypto_box.make_target [Int64.shift_left 1L 48]
 let id1 = Identity.generate proof_of_work_target
 let id2 = Identity.generate proof_of_work_target
 
 let id0 =
   (* Luckilly, this will be an insuficient proof of work! *)
-  Identity.generate (Crypto_box.make_target [])
+  Identity.generate (Crypto_box.make_target 0.)
 
 let versions = Version.[{ name = "TEST" ; minor = 0 ; major = 0 }]
 
@@ -83,11 +82,17 @@ let simple_msg =
 
 let is_rejected = function
   | Error [P2p_connection.Rejected] -> true
-  | Ok _ | Error _ -> false
+  | Ok _ -> false
+  | Error err ->
+      log_notice "Error: %a" pp_print_error err ;
+      false
 
 let is_connection_closed = function
   | Error [P2p_io_scheduler.Connection_closed] -> true
-  | Ok _ | Error _ -> false
+  | Ok _ -> false
+  | Error err ->
+      log_notice "Error: %a" pp_print_error err ;
+      false
 
 let bytes_encoding = Data_encoding.Variable.bytes
 

test/test_p2p_connection_pool.ml

@@ -126,7 +126,7 @@ let run_net config repeat points addr port =
 
 let make_net points repeat n =
   let point, points = Utils.select n points in
-  let proof_of_work_target = Crypto_box.make_target [] in
+  let proof_of_work_target = Crypto_box.make_target 0. in
   let identity = Identity.generate proof_of_work_target in
   let config = P2p_connection_pool.{
     identity ;
@@ -158,7 +158,7 @@ let make_net points repeat n =
 let addr = ref Ipaddr.V6.localhost
 let port = ref (1024 + Random.int 8192)
 let clients = ref 10
-let repeat = ref 5
+let repeat_connections = ref 5
 
 let spec = Arg.[
 
@@ -169,7 +169,8 @@ let spec = Arg.[
 
     "--clients", Set_int clients,  " Number of concurrent clients." ;
 
-    "--repeat", Set_int repeat,  " Number of connections/disconnections." ;
+    "--repeat", Set_int repeat_connections,
+    " Number of connections/disconnections." ;
 
     "-v", Unit (fun () -> Lwt_log_core.(add_rule "p2p.connection-pool" Info)),
     " Log up to info msgs" ;
@@ -181,16 +182,15 @@ let spec = Arg.[
 
 let main () =
   let open Utils in
+  Logging.init Stderr >>= fun () ->
   let anon_fun num_peers = raise (Arg.Bad "No anonymous argument.") in
   let usage_msg = "Usage: %s <num_peers>.\nArguments are:" in
   Arg.parse spec anon_fun usage_msg ;
   let ports = !port -- (!port + !clients - 1) in
   let points = List.map (fun port -> !addr, port) ports in
-  Lwt_list.iter_p (make_net points !repeat) (0 -- (!clients - 1))
+  Lwt_list.iter_p (make_net points !repeat_connections) (0 -- (!clients - 1))
 
 let () =
   Sys.catch_break true ;
-  try
+  try Lwt_main.run @@ main ()
-    Logging.init Stderr ;
-    Lwt_main.run @@ main ()
   with _ -> ()

test/test_p2p_io_scheduler.ml

@@ -140,7 +140,7 @@ let run
     ?max_download_speed ?max_upload_speed
     ~read_buffer_size ?read_queue_size ?write_queue_size
     addr port time n =
-  Logging.init Stderr ;
+  Logging.init Stderr >>= fun () ->
   listen ?port addr >>= fun (main_socket, port) ->
   let server =
     Process.detach ~prefix:"server " begin fun () ->

test/test_state.ml

@@ -39,7 +39,7 @@ let incr_fitness fitness =
     | [ _ ; fitness ] ->
         Pervasives.(
           Data_encoding.Binary.of_bytes Data_encoding.int64 fitness
-          |> Utils.unopt 0L
+          |> Utils.unopt ~default:0L
           |> Int64.succ
           |> Data_encoding.Binary.to_bytes Data_encoding.int64
         )