Jbuilder: split src/utils/ in multiple OPAM packages

* `lib_stdlib`: basic extended OCaml stdlib and generic data structures

* `lib_data_encoding`: almost independant 'Data_encoding'
* `lib_error_monad`: almost independant 'Error_monad'

* `lib_stdlib_lwt`: extended Lwt library
* `lib_crypto`: all the crypto stuff (hashing, signing, cryptobox).

* `lib_base`:
  - basic type definitions (Block_header, Operation, ...)
  - a module `TzPervasives` to bind them all and to be the
    single module opened everywhere.

In the process, I splitted `Tezos_data` and `Hash` in multiple
submodules, thus removing a lot of `-open`.

The following two modules may not have found their place yet:
- Base58 (currently in `lib_crypto`)
- Cli_entries (currently in `lib_stdlib_lwt`)

Makefile

@@ -2,7 +2,10 @@
 DEV ?= --dev
 
 all:
-	@jbuilder build tezos.install ${DEV}
+	@jbuilder build ${DEV} \
+		src/node_main.exe \
+		src/client_main.exe \
+		src/compiler_main.exe
 	@cp _build/default/src/node_main.exe tezos-node
 	@cp _build/default/src/client_main.exe tezos-client
 	@cp _build/default/src/compiler_main.exe tezos-protocol-compiler

jbuild

@@ -1,63 +1,5 @@
 (jbuild_version 1)
 
-(alias
- ((name runtest_indent)
-  (deps ( ;; Hack... list all directories
-         (glob_files scripts/*.ml)
-         (glob_files scripts/*.mli)
-         (glob_files src/*.ml)
-         (glob_files src/*.mli)
-         (glob_files src/attacker/*.ml)
-         (glob_files src/attacker/*.mli)
-         (glob_files src/client/*.ml)
-         (glob_files src/client/*.mli)
-         (glob_files src/client/embedded/alpha/*.ml)
-         (glob_files src/client/embedded/alpha/*.mli)
-         (glob_files src/client/embedded/demo/*.ml)
-         (glob_files src/client/embedded/demo/*.mli)
-         (glob_files src/client/embedded/genesis/*.ml)
-         (glob_files src/client/embedded/genesis/*.mli)
-         (glob_files src/compiler/*.ml)
-         (glob_files src/compiler/*.mli)
-         (glob_files src/environment/sigs_packer/*.ml)
-         (glob_files src/environment/sigs_packer/*.mli)
-         (glob_files src/environment/v1/*.ml)
-         (glob_files src/environment/v1/*.mli)
-         (glob_files src/micheline/*.ml)
-         (glob_files src/micheline/*.mli)
-         (glob_files src/minutils/*.ml)
-         (glob_files src/minutils/*.mli)
-         (glob_files src/node/db/*.ml)
-         (glob_files src/node/db/*.mli)
-         (glob_files src/node/main/*.ml)
-         (glob_files src/node/main/*.mli)
-         (glob_files src/node/net/*.ml)
-         (glob_files src/node/net/*.mli)
-         (glob_files src/node/shell/*.ml)
-         (glob_files src/node/shell/*.mli)
-         (glob_files src/node/updater/*.ml)
-         (glob_files src/node/updater/*.mli)
-         (glob_files src/proto/alpha/*.ml)
-         (glob_files src/proto/alpha/*.mli)
-         (glob_files src/proto/demo/*.ml)
-         (glob_files src/proto/demo/*.mli)
-         (glob_files src/proto/genesis/*.ml)
-         (glob_files src/proto/genesis/*.mli)
-         (glob_files src/utils/*.ml)
-         (glob_files src/utils/*.mli)
-         (glob_files test/lib/*.ml)
-         (glob_files test/lib/*.mli)
-         (glob_files test/p2p/*.ml)
-         (glob_files test/p2p/*.mli)
-         (glob_files test/proto_alpha/*.ml)
-         (glob_files test/proto_alpha/*.mli)
-         (glob_files test/shell/*.ml)
-         (glob_files test/shell/*.mli)
-         (glob_files test/utils/*.ml)
-         (glob_files test/utils/*.mli)
-         ))
-  (action (run bash ${path:scripts/test-ocp-indent.sh}))))
-
 (alias
  ((name runtest)
-  (deps ((alias runtest_indent)))))
+  (deps ((alias_rec runtest_indent)))))

lib_base/block_header.ml

@@ -0,0 +1,90 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type shell_header = {
+  level: Int32.t ;
+  proto_level: int ; (* uint8 *)
+  predecessor: Block_hash.t ;
+  timestamp: Time.t ;
+  validation_passes: int ; (* uint8 *)
+  operations_hash: Operation_list_list_hash.t ;
+  fitness: MBytes.t list ;
+}
+
+let shell_header_encoding =
+  let open Data_encoding in
+  conv
+    (fun { level ; proto_level ; predecessor ;
+           timestamp ; validation_passes ; operations_hash ; fitness } ->
+      (level, proto_level, predecessor,
+       timestamp, validation_passes, operations_hash, fitness))
+    (fun (level, proto_level, predecessor,
+          timestamp, validation_passes, operations_hash, fitness) ->
+      { level ; proto_level ; predecessor ;
+        timestamp ; validation_passes ; operations_hash ; fitness })
+    (obj7
+       (req "level" int32)
+       (req "proto" uint8)
+       (req "predecessor" Block_hash.encoding)
+       (req "timestamp" Time.encoding)
+       (req "validation_pass" uint8)
+       (req "operations_hash" Operation_list_list_hash.encoding)
+       (req "fitness" Fitness.encoding))
+
+type t = {
+  shell: shell_header ;
+  proto: MBytes.t ;
+}
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { shell ; proto } -> (shell, proto))
+    (fun (shell, proto) -> { shell ; proto })
+    (merge_objs
+       shell_header_encoding
+       (obj1 (req "data" Variable.bytes)))
+
+let pp fmt op =
+  Format.pp_print_string fmt @@
+  Data_encoding_ezjsonm.to_string (Data_encoding.Json.construct encoding op)
+
+let compare b1 b2 =
+  let (>>) x y = if x = 0 then y () else x in
+  let rec list compare xs ys =
+    match xs, ys with
+    | [], [] -> 0
+    | _ :: _, [] -> -1
+    | [], _ :: _ -> 1
+    | x :: xs, y :: ys ->
+        compare x y >> fun () -> list compare xs ys in
+  Block_hash.compare b1.shell.predecessor b2.shell.predecessor >> fun () ->
+  compare b1.proto b2.proto >> fun () ->
+  Operation_list_list_hash.compare
+    b1.shell.operations_hash b2.shell.operations_hash >> fun () ->
+  Time.compare b1.shell.timestamp b2.shell.timestamp >> fun () ->
+  list compare b1.shell.fitness b2.shell.fitness
+
+let equal b1 b2 = compare b1 b2 = 0
+
+let (=) = equal
+let (<>) x y = compare x y <> 0
+let (<) x y = compare x y < 0
+let (<=) x y = compare x y <= 0
+let (>=) x y = compare x y >= 0
+let (>) x y = compare x y > 0
+let min x y = if x <= y then x else y
+let max x y = if x <= y then y else x
+
+let to_bytes v = Data_encoding.Binary.to_bytes encoding v
+let of_bytes b = Data_encoding.Binary.of_bytes encoding b
+let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
+
+let hash block = Block_hash.hash_bytes [to_bytes block]
+let hash_raw bytes = Block_hash.hash_bytes [bytes]

lib_base/block_header.mli

@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type shell_header = {
+  level: Int32.t ;
+  proto_level: int ; (* uint8 *)
+  predecessor: Block_hash.t ;
+  timestamp: Time.t ;
+  validation_passes: int ; (* uint8 *)
+  operations_hash: Operation_list_list_hash.t ;
+  fitness: MBytes.t list ;
+}
+
+val shell_header_encoding: shell_header Data_encoding.t
+
+type t = {
+  shell: shell_header ;
+  proto: MBytes.t ;
+}
+
+include S.HASHABLE with type t := t
+                    and type hash := Block_hash.t
+val of_bytes_exn: MBytes.t -> t

lib_base/fitness.ml

@@ -0,0 +1,65 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t = MBytes.t list
+
+(* Fitness comparison:
+   - shortest lists are smaller ;
+   - lexicographical order for lists of the same length. *)
+let compare_bytes b1 b2 =
+  let len1 = MBytes.length b1 in
+  let len2 = MBytes.length b2 in
+  let c = compare len1 len2 in
+  if c <> 0
+  then c
+  else
+    let rec compare_byte b1 b2 pos len =
+      if pos = len
+      then 0
+      else
+        let c = compare (MBytes.get_char b1 pos) (MBytes.get_char b2 pos) in
+        if c <> 0
+        then c
+        else compare_byte b1 b2 (pos+1) len
+    in
+    compare_byte b1 b2 0 len1
+
+let compare f1 f2 =
+  let rec compare_rec f1 f2 = match f1, f2 with
+    | [], [] -> 0
+    | i1 :: f1, i2 :: f2 ->
+        let i = compare_bytes i1 i2 in
+        if i = 0 then compare_rec f1 f2 else i
+    | _, _ -> assert false in
+  let len = compare (List.length f1) (List.length f2) in
+  if len = 0 then compare_rec f1 f2 else len
+
+let equal f1 f2 = compare f1 f2 = 0
+
+let (=) = equal
+let (<>) x y = compare x y <> 0
+let (<) x y = compare x y < 0
+let (<=) x y = compare x y <= 0
+let (>=) x y = compare x y >= 0
+let (>) x y = compare x y > 0
+let min x y = if x <= y then x else y
+let max x y = if x <= y then y else x
+
+let rec pp fmt = function
+  | [] -> ()
+  | [f] -> Format.fprintf fmt "%s" (Hex_encode.hex_of_bytes f)
+  | f1 :: f -> Format.fprintf fmt "%s::%a" (Hex_encode.hex_of_bytes f1) pp f
+
+let encoding =
+  let open Data_encoding in
+  describe ~title: "Tezos block fitness"
+    (list bytes)
+
+let to_bytes v = Data_encoding.Binary.to_bytes encoding v
+let of_bytes b = Data_encoding.Binary.of_bytes encoding b

lib_base/fitness.mli

@@ -0,0 +1,10 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include S.T with type t = MBytes.t list

lib_base/jbuild

@@ -0,0 +1,22 @@
+(jbuild_version 1)
+
+(library
+ ((name tezos_base)
+  (public_name tezos-base)
+  (flags (:standard -open Tezos_stdlib
+                    -open Tezos_stdlib_lwt
+                    -open Tezos_crypto
+                    -open Tezos_data_encoding
+                    -open Tezos_error_monad))
+  (libraries (tezos-stdlib
+              tezos-stdlib-lwt
+              tezos-crypto
+              tezos-data-encoding
+              tezos-error-monad
+              ezjsonm
+              calendar))))
+
+(alias
+ ((name runtest_indent)
+  (deps ((glob_files *.ml) (glob_files *.mli)))
+  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${<}))))

lib_base/operation.ml

@@ -0,0 +1,59 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type shell_header = {
+  branch: Block_hash.t ;
+}
+
+let shell_header_encoding =
+  let open Data_encoding in
+  conv
+    (fun { branch } -> branch)
+    (fun branch -> { branch })
+    (obj1 (req "branch" Block_hash.encoding))
+
+type t = {
+  shell: shell_header ;
+  proto: MBytes.t ;
+}
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { shell ; proto } -> (shell, proto))
+    (fun (shell, proto) -> { shell ; proto })
+    (merge_objs
+       shell_header_encoding
+       (obj1 (req "data" Variable.bytes)))
+
+let pp fmt op =
+  Format.pp_print_string fmt @@
+  Data_encoding_ezjsonm.to_string (Data_encoding.Json.construct encoding op)
+
+let compare o1 o2 =
+  let (>>) x y = if x = 0 then y () else x in
+  Block_hash.compare o1.shell.branch o1.shell.branch >> fun () ->
+  MBytes.compare o1.proto o2.proto
+let equal b1 b2 = compare b1 b2 = 0
+
+let (=) = equal
+let (<>) x y = compare x y <> 0
+let (<) x y = compare x y < 0
+let (<=) x y = compare x y <= 0
+let (>=) x y = compare x y >= 0
+let (>) x y = compare x y > 0
+let min x y = if x <= y then x else y
+let max x y = if x <= y then y else x
+
+let to_bytes v = Data_encoding.Binary.to_bytes encoding v
+let of_bytes b = Data_encoding.Binary.of_bytes encoding b
+let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
+
+let hash op = Operation_hash.hash_bytes [to_bytes op]
+let hash_raw bytes = Operation_hash.hash_bytes [bytes]
+

lib_base/operation.mli

@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type shell_header = {
+  branch: Block_hash.t ;
+}
+val shell_header_encoding: shell_header Data_encoding.t
+
+type t = {
+  shell: shell_header ;
+  proto: MBytes.t ;
+}
+
+include S.HASHABLE with type t := t
+                    and type hash := Operation_hash.t
+val of_bytes_exn: MBytes.t -> t

lib_base/protocol.ml

@@ -0,0 +1,71 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t = {
+  expected_env: env_version ;
+  components: component list ;
+}
+
+and component = {
+  name: string ;
+  interface: string option ;
+  implementation: string ;
+}
+
+and env_version = V1
+
+let component_encoding =
+  let open Data_encoding in
+  conv
+    (fun { name ; interface; implementation } ->
+       (name, interface, implementation))
+    (fun (name, interface, implementation) ->
+       { name ; interface ; implementation })
+    (obj3
+       (req "name" string)
+       (opt "interface" string)
+       (req "implementation" string))
+
+let env_version_encoding =
+  let open Data_encoding in
+  conv
+    (function V1 -> 0)
+    (function 0 -> V1 | _ -> failwith "unexpected environment version")
+    int16
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { expected_env ; components } -> (expected_env, components))
+    (fun (expected_env, components) -> { expected_env ; components })
+    (obj2
+       (req "expected_env_version" env_version_encoding)
+       (req "components" (list component_encoding)))
+
+let pp fmt op =
+  Format.pp_print_string fmt @@
+  Data_encoding_ezjsonm.to_string (Data_encoding.Json.construct encoding op)
+
+let compare = Pervasives.compare
+let equal = (=)
+
+let (=) = equal
+let (<>) x y = compare x y <> 0
+let (<) x y = compare x y < 0
+let (<=) x y = compare x y <= 0
+let (>=) x y = compare x y >= 0
+let (>) x y = compare x y > 0
+let min x y = if x <= y then x else y
+let max x y = if x <= y then y else x
+
+let to_bytes v = Data_encoding.Binary.to_bytes encoding v
+let of_bytes b = Data_encoding.Binary.of_bytes encoding b
+let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
+let hash proto = Protocol_hash.hash_bytes [to_bytes proto]
+let hash_raw proto = Protocol_hash.hash_bytes [proto]

lib_base/protocol.mli

@@ -0,0 +1,29 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t = {
+  expected_env: env_version ;
+  components: component list ;
+}
+
+and component = {
+  name: string ;
+  interface: string option ;
+  implementation: string ;
+}
+
+and env_version = V1
+
+val component_encoding: component Data_encoding.t
+val env_version_encoding: env_version Data_encoding.t
+
+include S.HASHABLE with type t := t
+                    and type hash := Protocol_hash.t
+val of_bytes_exn: MBytes.t -> t
+

lib_base/s.ml

@@ -0,0 +1,42 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+module type T = sig
+
+  type t
+
+  val compare: t -> t -> int
+  val equal: t -> t -> bool
+
+  val (=): t -> t -> bool
+  val (<>): t -> t -> bool
+  val (<): t -> t -> bool
+  val (<=): t -> t -> bool
+  val (>=): t -> t -> bool
+  val (>): t -> t -> bool
+  val min: t -> t -> t
+  val max: t -> t -> t
+
+  val pp: Format.formatter -> t -> unit
+
+  val encoding: t Data_encoding.t
+  val to_bytes: t -> MBytes.t
+  val of_bytes: MBytes.t -> t option
+
+end
+
+module type HASHABLE = sig
+
+  include T
+
+  type hash
+  val hash: t -> hash
+  val hash_raw: MBytes.t -> hash
+
+end

lib_base/tezos-base.opam

@@ -0,0 +1,26 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "https://gitlab.com/tezos/tezos.git"
+license: "unreleased"
+depends: [
+  "ocamlfind" { build }
+  "jbuilder" { build & >= "1.0+beta15" }
+  "base-bigarray"
+  "tezos-stdlib"
+  "tezos-stdlib-lwt"
+  "tezos-crypto"
+  "tezos-data-encoding"
+  "tezos-error-monad"
+  "ezjsonm"
+  "calendar"
+]
+build: [
+  [ "jbuilder" "build" "-p" name "-j" jobs ]
+]
+build-test: [
+  [ "jbuilder" "runtest" "-p" name "-j" jobs ]
+]

lib_base/tzPervasives.ml

@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include Tezos_stdlib
+include Tezos_stdlib_lwt
+include Tezos_crypto
+include Tezos_data_encoding
+include Tezos_error_monad
+
+module List = struct
+  include List
+  include Tezos_stdlib.TzList
+end
+module String = struct
+  include String
+  include Tezos_stdlib.TzString
+end
+
+module Time = Time
+module Data_encoding_ezjsonm = Data_encoding_ezjsonm
+module Fitness = Fitness
+module Block_header = Block_header
+module Operation = Operation
+module Protocol = Protocol
+
+include Utils.Infix
+include Error_monad

lib_base/tzPervasives.mli

@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include (module type of (struct include Tezos_stdlib end))
+include (module type of (struct include Tezos_data_encoding end))
+include (module type of (struct include Tezos_stdlib_lwt end))
+include (module type of (struct include Tezos_crypto end))
+include (module type of (struct include Tezos_error_monad end))
+
+module List : sig
+  include (module type of (struct include List end))
+  include (module type of (struct include Tezos_stdlib.TzList end))
+end
+module String : sig
+  include (module type of (struct include String end))
+  include (module type of (struct include Tezos_stdlib.TzString end))
+end
+
+module Time = Time
+module Data_encoding_ezjsonm = Data_encoding_ezjsonm
+module Fitness = Fitness
+module Block_header = Block_header
+module Operation = Operation
+module Protocol = Protocol
+
+include (module type of (struct include Utils.Infix end))
+include (module type of (struct include Error_monad end))

lib_crypto/base58.ml

@@ -7,16 +7,11 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Utils
 open Lwt.Infix
 
 let base = 58
 let zbase = Z.of_int base
 
-let log2 x = log x /. log 2.
-let log2_base = log2 (float_of_int base)
-
-
 module Alphabet = struct
 
   type t = { encode: string ; decode: string }
@@ -53,7 +48,7 @@ module Alphabet = struct
     done;
     !res
 
-  let pp ppf { encode } = Format.fprintf ppf "%s" encode
+  let pp ppf { encode ; _ } = Format.fprintf ppf "%s" encode
 
 end
 
@@ -75,7 +70,7 @@ let count_leading_char s c =
 
 let of_char ?(alphabet=Alphabet.default) x =
   let pos = String.get alphabet.decode (int_of_char x) in
-  if pos = '\255' then failwith "Invalid data" ;
+  if pos = '\255' then Pervasives.failwith "Invalid data" ;
   int_of_char pos
 
 let to_char ?(alphabet=Alphabet.default) x =
@@ -149,12 +144,12 @@ type 'a encoding = {
   wrap: 'a -> data ;
 }
 
-let simple_decode ?alphabet { prefix ; of_raw } s =
+let simple_decode ?alphabet { prefix ; of_raw ; _ } s =
   safe_decode ?alphabet s |>
-  remove_prefix ~prefix |>
+  TzString.remove_prefix ~prefix |>
-  Utils.apply_option ~f:of_raw
+  Option.apply ~f:of_raw
 
-let simple_encode ?alphabet { prefix ; to_raw } d =
+let simple_encode ?alphabet { prefix ; to_raw ; _ } d =
   safe_encode ?alphabet (prefix ^ to_raw d)
 
 type registred_encoding = Encoding : 'a encoding -> registred_encoding
@@ -167,9 +162,9 @@ module MakeEncodings(E: sig
 
   let check_ambiguous_prefix prefix encodings =
     List.iter
-      (fun (Encoding { encoded_prefix = s }) ->
+      (fun (Encoding { encoded_prefix = s ; _ }) ->
-         if remove_prefix ~prefix:s prefix <> None ||
+         if TzString.remove_prefix ~prefix:s prefix <> None ||
-            remove_prefix ~prefix s <> None then
+            TzString.remove_prefix ~prefix s <> None then
            Format.ksprintf invalid_arg
              "Base58.register_encoding: duplicate prefix: %S, %S." s prefix)
       encodings
@@ -205,11 +200,11 @@ module MakeEncodings(E: sig
 
   let check_encoded_prefix enc p l =
     if enc.encoded_prefix <> p then
-      Format.kasprintf failwith
+      Format.kasprintf Pervasives.failwith
         "Unexpected prefix %s (expected %s)"
         p enc.encoded_prefix ;
     if enc.encoded_length <> l then
-      Format.kasprintf failwith
+      Format.kasprintf Pervasives.failwith
         "Unexpected encoded length %d for %s (expected %d)"
         l p enc.encoded_length
 
@@ -217,14 +212,15 @@ module MakeEncodings(E: sig
     try
       let rec find s = function
         | [] -> None
-        | Encoding { prefix ; of_raw ; wrap } :: encodings ->
+        | Encoding { prefix ; of_raw ; wrap ; _ } :: encodings ->
-            match remove_prefix ~prefix s with
+            match TzString.remove_prefix ~prefix s with
             | None -> find s encodings
-            | Some msg -> of_raw msg |> Utils.map_option ~f:wrap in
+            | Some msg -> of_raw msg |> Option.map ~f:wrap in
       let s = safe_decode ?alphabet s in
       find s !encodings
     with Invalid_argument _ -> None
 
+
 end
 
 type 'a resolver =
@@ -235,7 +231,6 @@ type 'a resolver =
 
 module MakeResolvers(R: sig
     type context
-    val encodings: registred_encoding list ref
   end) = struct
 
   let resolvers = ref []
@@ -252,14 +247,14 @@ module MakeResolvers(R: sig
     let n = String.length request in
     let min = raw_decode ~alphabet (request ^ String.make (len - n) zero) in
     let max = raw_decode ~alphabet (request ^ String.make (len - n) last) in
-    let prefix_len = Utils.common_prefix min max in
+    let prefix_len = TzString.common_prefix min max in
     String.sub min 0 prefix_len
 
   let complete ?alphabet context request =
     let rec find s = function
       | [] -> Lwt.return_nil
       | Resolver { encoding ; resolver } :: resolvers ->
-          if not (has_prefix ~prefix:encoding.encoded_prefix s) then
+          if not (TzString.has_prefix ~prefix:encoding.encoded_prefix s) then
             find s resolvers
           else
             let prefix =
@@ -273,11 +268,11 @@ module MakeResolvers(R: sig
                 String.sub prefix ignored (len - ignored)
               end in
             resolver context msg >|= fun msgs ->
-            filter_map
+            TzList.filter_map
               (fun msg ->
                  let res = simple_encode encoding ?alphabet msg in
-                 Utils.remove_prefix ~prefix:request res |>
+                 TzString.remove_prefix ~prefix:request res |>
-                 Utils.map_option ~f:(fun _ -> res))
+                 Option.map ~f:(fun _ -> res))
               msgs in
     find request !resolvers
 
@@ -286,7 +281,6 @@ end
 include MakeEncodings(struct let encodings = [] end)
 include MakeResolvers(struct
     type context = unit
-    let encodings = encodings
   end)
 
 let register_resolver enc f = register_resolver enc (fun () s -> f s)
@@ -296,7 +290,6 @@ module Make(C: sig type context end) = struct
   include MakeEncodings(struct let encodings = !encodings end)
   include MakeResolvers(struct
       type context = C.context
-      let encodings = encodings
     end)
 end
 

lib_crypto/blake2B.ml

@@ -7,12 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-let (//) = Filename.concat
-let (>>=) = Lwt.bind
-let (>|=) = Lwt.(>|=)
-
-open Error_monad
-
 let () =
   let expected_primitive = "blake2b"
   and primitive = Sodium.Generichash.primitive in
@@ -24,130 +18,9 @@ let () =
     exit 1
   end
 
-(*-- Signatures -------------------------------------------------------------*)
-
-module type MINIMAL_HASH = sig
-
-  type t
-
-  val name: string
-  val title: string
-
-  val hash_bytes: MBytes.t list -> t
-  val hash_string: string list -> t
-  val size: int (* in bytes *)
-  val compare: t -> t -> int
-  val equal: t -> t -> bool
-
-  val to_hex: t -> string
-  val of_hex: string -> t option
-  val of_hex_exn: string -> t
-
-  val to_string: t -> string
-  val of_string: string -> t option
-  val of_string_exn: string -> t
-
-  val to_bytes: t -> MBytes.t
-  val of_bytes: MBytes.t -> t option
-  val of_bytes_exn: MBytes.t -> t
-
-  val read: MBytes.t -> int -> t
-  val write: MBytes.t -> int -> t -> unit
-
-  val to_path: t -> string list -> string list
-  val of_path: string list -> t option
-  val of_path_exn: string list -> t
-
-  val prefix_path: string -> string list
-  val path_length: int
-
-end
-
-module type INTERNAL_MINIMAL_HASH = sig
-  include MINIMAL_HASH
-  module Table : Hashtbl.S with type key = t
-end
-
-module type HASH = sig
-
-  include MINIMAL_HASH
-
-  val of_b58check_exn: string -> t
-  val of_b58check_opt: string -> t option
-  val to_b58check: t -> string
-  val to_short_b58check: t -> string
-  val encoding: t Data_encoding.t
-  val pp: Format.formatter -> t -> unit
-  val pp_short: Format.formatter -> t -> unit
-  type Base58.data += Hash of t
-  val b58check_encoding: t Base58.encoding
-
-  module Set : sig
-    include Set.S with type elt = t
-    val encoding: t Data_encoding.t
-  end
-
-  module Map : sig
-    include Map.S with type key = t
-    val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t
-  end
-
-end
-
-module type INTERNAL_HASH = sig
-  include HASH
-  val of_b58check: string -> t tzresult
-  val param:
-    ?name:string ->
-    ?desc:string ->
-    ('a, 'arg, 'ret) Cli_entries.params ->
-    (t -> 'a, 'arg, 'ret) Cli_entries.params
-  val random_set_elt: Set.t -> t
-  module Table : Hashtbl.S with type key = t
-end
-
-module type INTERNAL_MERKLE_TREE = sig
-  type elt
-  include INTERNAL_HASH
-  val compute: elt list -> t
-  val empty: t
-  type path =
-    | Left of path * t
-    | Right of t * path
-    | Op
-  val compute_path: elt list -> int -> path
-  val check_path: path -> elt -> t * int
-  val path_encoding: path Data_encoding.t
-end
-
-module type MERKLE_TREE = sig
-  type elt
-  include HASH
-  val compute: elt list -> t
-  val empty: t
-  type path =
-    | Left of path * t
-    | Right of t * path
-    | Op
-  val compute_path: elt list -> int -> path
-  val check_path: path -> elt -> t * int
-  val path_encoding: path Data_encoding.t
-end
-
-module type Name = sig
-  val name: string
-  val title:  string
-  val size: int option
-end
-
-module type PrefixedName = sig
-  include Name
-  val b58check_prefix: string
-end
-
 (*-- Type specific Hash builder ---------------------------------------------*)
 
-module Make_minimal_Blake2B (K : Name) = struct
+module Make_minimal (K : S.Name) = struct
 
   type t = Sodium.Generichash.hash
 
@@ -212,19 +85,6 @@ module Make_minimal_Blake2B (K : Name) = struct
       l ;
     final state
 
-  let fold_read f buf off len init =
-    let last = off + len * size in
-    if last > MBytes.length buf then
-      invalid_arg "Hash.read_set: invalid size.";
-    let rec loop acc off =
-      if off >= last then
-        acc
-      else
-        let hash = read buf off in
-        loop (f hash acc) (off + size)
-    in
-    loop init off
-
   let path_length = 6
   let to_path key l =
     let key = to_hex key in
@@ -263,7 +123,7 @@ module Make_minimal_Blake2B (K : Name) = struct
 
 end
 
-module Make_Blake2B (R : sig
+module Make (R : sig
     val register_encoding:
       prefix: string ->
       length:int ->
@@ -271,9 +131,9 @@ module Make_Blake2B (R : sig
       of_raw: (string -> 'a option) ->
       wrap: ('a -> Base58.data) ->
       'a Base58.encoding
-  end) (K : PrefixedName) = struct
+  end) (K : S.PrefixedName) = struct
 
-  include Make_minimal_Blake2B(K)
+  include Make_minimal(K)
 
   (* Serializers *)
 
@@ -382,7 +242,7 @@ module Generic_Merkle_tree (H : sig
     | [] -> H.empty
     | [x] -> H.leaf x
     | _ :: _ :: _ ->
-        let last = Utils.list_last_exn xs in
+        let last = TzList.last_exn xs in
         let n = List.length xs in
         let a = Array.make (n+1) (H.leaf last) in
         List.iteri (fun i x -> a.(i) <- H.leaf x) xs ;
@@ -414,7 +274,7 @@ module Generic_Merkle_tree (H : sig
     | [] -> invalid_arg "compute_path"
     | [_] -> Op
     | _ :: _ :: _ ->
-        let last = Utils.list_last_exn xs in
+        let last = TzList.last_exn xs in
         let n = List.length xs in
         if i < 0 || n <= i then invalid_arg "compute_path" ;
         let a = Array.make (n+1) (H.leaf last) in
@@ -471,13 +331,13 @@ module Make_merkle_tree
          wrap: ('a -> Base58.data) ->
          'a Base58.encoding
      end)
-    (K : PrefixedName)
+    (K : S.PrefixedName)
     (Contents: sig
        type t
        val to_bytes: t -> MBytes.t
      end) = struct
 
-  include Make_Blake2B (R) (K)
+  include Make (R) (K)
 
   type elt = Contents.t
 
@@ -494,215 +354,9 @@ module Make_merkle_tree
 
 end
 
-(*-- Pre-instanciated hashes ------------------------------------------------*)
+include
-
+  Make_minimal (struct
-module Block_hash =
-  Make_Blake2B (Base58) (struct
-    let name = "Block_hash"
-    let title = "A Tezos block ID"
-    let b58check_prefix = Base58.Prefix.block_hash
-    let size = None
-  end)
-
-module Operation_hash =
-  Make_Blake2B (Base58) (struct
-    let name = "Operation_hash"
-    let title = "A Tezos operation ID"
-    let b58check_prefix = Base58.Prefix.operation_hash
-    let size = None
-  end)
-
-module Operation_list_hash =
-  Make_merkle_tree (Base58) (struct
-    let name = "Operation_list_hash"
-    let title = "A list of operations"
-    let b58check_prefix = Base58.Prefix.operation_list_hash
-    let size = None
-  end) (Operation_hash)
-
-module Operation_list_list_hash =
-  Make_merkle_tree (Base58) (struct
-    let name = "Operation_list_list_hash"
-    let title = "A list of list of operations"
-    let b58check_prefix = Base58.Prefix.operation_list_list_hash
-    let size = None
-  end) (Operation_list_hash)
-
-module Protocol_hash =
-  Make_Blake2B (Base58) (struct
-    let name = "Protocol_hash"
-    let title = "A Tezos protocol ID"
-    let b58check_prefix = Base58.Prefix.protocol_hash
-    let size = None
-  end)
-
-module Generic_hash =
-  Make_minimal_Blake2B (struct
     let name = "Generic_hash"
     let title = ""
     let size = None
   end)
-
-module Net_id = struct
-
-  type t = string
-
-  let name = "Net_id"
-  let title = "Network identifier"
-
-  let size = 4
-
-  let extract bh =
-    MBytes.substring (Block_hash.to_bytes bh) 0 4
-
-  let hash_bytes l = extract (Block_hash.hash_bytes l)
-  let hash_string l = extract (Block_hash.hash_string l)
-
-  let of_block_hash bh = hash_bytes [Block_hash.to_bytes bh]
-
-  type Base58.data += Hash of t
-
-  let of_string s =
-    if String.length s <> size then None else Some s
-  let of_string_exn s =
-    match of_string s with
-    | None ->
-        let msg =
-          Printf.sprintf "%s.of_string: wrong string size (%d)"
-            name (String.length s) in
-        raise (Invalid_argument msg)
-    | Some h -> h
-  let to_string s = s
-
-  let of_hex s = of_string (Hex_encode.hex_decode s)
-  let of_hex_exn s = of_string_exn (Hex_encode.hex_decode s)
-  let to_hex s = Hex_encode.hex_encode (to_string s)
-
-  let compare = String.compare
-  let equal = String.equal
-
-  let of_bytes b =
-    if MBytes.length b <> size then
-      None
-    else
-      Some (MBytes.to_string b)
-  let of_bytes_exn b =
-    match of_bytes b with
-    | None ->
-        let msg =
-          Printf.sprintf "%s.of_bytes: wrong string size (%d)"
-            name (MBytes.length b) in
-        raise (Invalid_argument msg)
-    | Some h -> h
-  let to_bytes = MBytes.of_string
-
-  let read src off = of_bytes_exn @@ MBytes.sub src off size
-  let write dst off h = MBytes.blit (to_bytes h) 0 dst off size
-
-  let b58check_encoding =
-    Base58.register_encoding
-      ~prefix: Base58.Prefix.net_id
-      ~length: size
-      ~wrap: (fun s -> Hash s)
-      ~of_raw:of_string ~to_raw: (fun h -> h)
-
-  let of_b58check_opt s =
-    Base58.simple_decode b58check_encoding s
-  let of_b58check_exn s =
-    match Base58.simple_decode b58check_encoding s with
-    | Some x -> x
-    | None -> Format.kasprintf Pervasives.failwith "Unexpected hash (%s)" name
-  let of_b58check s =
-    match Base58.simple_decode b58check_encoding s with
-    | Some x -> Ok x
-    | None -> generic_error "Unexpected hash (%s)" name
-  let to_b58check s = Base58.simple_encode b58check_encoding s
-  let to_short_b58check = to_b58check
-
-  let encoding =
-    let open Data_encoding in
-    splitted
-      ~binary: (Fixed.string size)
-      ~json:
-        (describe ~title: (title ^ " (Base58Check-encoded Blake2B hash)") @@
-         conv to_b58check (Data_encoding.Json.wrap_error of_b58check_exn) string)
-
-  let param ?(name=name) ?(desc=title) t =
-    Cli_entries.(param ~name ~desc (parameter (fun _ str -> Lwt.return (of_b58check str))) t)
-
-  let pp ppf t =
-    Format.pp_print_string ppf (to_b58check t)
-
-  let pp_short ppf t =
-    Format.pp_print_string ppf (to_short_b58check t)
-
-  module Set = struct
-    include Set.Make(struct type nonrec t = t let compare = compare end)
-    exception Found of elt
-    let random_elt s =
-      let n = Random.int (cardinal s) in
-      try
-        ignore
-          (fold (fun x i -> if i = n then raise (Found x) ; i+1) s 0 : int) ;
-        assert false
-      with Found x -> x
-    let encoding =
-      Data_encoding.conv
-        elements
-        (fun l -> List.fold_left (fun m x -> add x m) empty l)
-        Data_encoding.(list encoding)
-  end
-  let random_set_elt = Set.random_elt
-
-  module Map = struct
-    include Map.Make(struct type nonrec t = t let compare = compare end)
-    let encoding arg_encoding =
-      Data_encoding.conv
-        bindings
-        (fun l -> List.fold_left (fun m (k,v) -> add k v m) empty l)
-        Data_encoding.(list (tup2 encoding arg_encoding))
-  end
-
-  let fold_read f buf off len init =
-    let last = off + len * size in
-    if last > MBytes.length buf then
-      invalid_arg "Hash.read_set: invalid size.";
-    let rec loop acc off =
-      if off >= last then
-        acc
-      else
-        let hash = read buf off in
-        loop (f hash acc) (off + size)
-    in
-    loop init off
-
-  let path_length = 1
-  let to_path key l = to_hex key :: l
-  let of_path path =
-    let path = String.concat "" path in
-    of_hex path
-  let of_path_exn path =
-    let path = String.concat "" path in
-    of_hex_exn path
-
-  let prefix_path p =
-    let p = Hex_encode.hex_encode p in
-    [ p ]
-
-  module Table = struct
-    include Hashtbl.Make(struct
-        type nonrec t = t
-        let hash = Hashtbl.hash
-        let equal = equal
-      end)
-  end
-
-end
-
-let () =
-  Base58.check_encoded_prefix Block_hash.b58check_encoding "B" 51 ;
-  Base58.check_encoded_prefix Operation_hash.b58check_encoding "o" 51 ;
-  Base58.check_encoded_prefix Operation_list_hash.b58check_encoding "Lo" 52 ;
-  Base58.check_encoded_prefix Operation_list_list_hash.b58check_encoding "LLo" 53 ;
-  Base58.check_encoded_prefix Protocol_hash.b58check_encoding "P" 51 ;
-  Base58.check_encoded_prefix Net_id.b58check_encoding "Net" 15

lib_crypto/blake2B.mli

@@ -0,0 +1,75 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Tezos - Manipulation and creation of hashes *)
+
+(** {2 Predefined Hashes } ****************************************************)
+
+include S.INTERNAL_MINIMAL_HASH
+
+(** Builds a new Hash type using Blake2B. *)
+module Make_minimal (Name : S.Name) : S.INTERNAL_MINIMAL_HASH
+module Make
+    (Register : sig
+       val register_encoding:
+         prefix: string ->
+         length: int ->
+         to_raw: ('a -> string) ->
+         of_raw: (string -> 'a option) ->
+         wrap: ('a -> Base58.data) ->
+         'a Base58.encoding
+     end)
+    (Name : S.PrefixedName) : S.INTERNAL_HASH
+
+(**/**)
+
+module Make_merkle_tree
+    (R : sig
+       val register_encoding:
+         prefix: string ->
+         length:int ->
+         to_raw: ('a -> string) ->
+         of_raw: (string -> 'a option) ->
+         wrap: ('a -> Base58.data) ->
+         'a Base58.encoding
+     end)
+    (K : S.PrefixedName)
+    (Contents: sig
+       type t
+       val to_bytes: t -> MBytes.t
+     end) : sig
+  include S.INTERNAL_HASH
+  type elt = Contents.t
+  val empty: t
+  val compute: elt list -> t
+  type path =
+    | Left of path * t
+    | Right of t * path
+    | Op
+  val path_encoding: path Data_encoding.t
+  val compute_path: elt list -> int -> path
+  val check_path: path -> elt -> t * int
+end
+
+module Generic_Merkle_tree (H : sig
+    type t
+    type elt
+    val encoding : t Data_encoding.t
+    val empty : t
+    val leaf : elt -> t
+    val node : t -> t -> t
+  end) : sig
+  val compute : H.elt list -> H.t
+  type path =
+    | Left of path * H.t
+    | Right of H.t * path
+    | Op
+  val compute_path: H.elt list -> int -> path
+  val check_path: path -> H.elt -> H.t * int
+end

lib_crypto/block_hash.ml

@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include Blake2B.Make (Base58) (struct
+    let name = "Block_hash"
+    let title = "A Tezos block ID"
+    let b58check_prefix = Base58.Prefix.block_hash
+    let size = None
+  end)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "B" 51

lib_crypto/block_hash.mli

@@ -0,0 +1,10 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include S.INTERNAL_HASH

lib_crypto/crypto_box.ml

@@ -15,7 +15,7 @@ type channel_key = Sodium.Box.channel_key
 type nonce = Sodium.Box.nonce
 type target = Z.t
 
-module Public_key_hash = Hash.Make_Blake2B (Base58) (struct
+module Public_key_hash = Blake2B.Make (Base58) (struct
     let name = "Crypto_box.Public_key_hash"
     let title = "A Cryptobox public key ID"
     let b58check_prefix = Base58.Prefix.cryptobox_public_key_hash
@@ -45,7 +45,7 @@ let fast_box_open ck msg nonce =
   | Sodium.Verification_failure -> None
 
 let compare_target hash target =
-  let hash = Z.of_bits (Hash.Generic_hash.to_string hash) in
+  let hash = Z.of_bits (Blake2B.to_string hash) in
   Z.compare hash target <= 0
 
 let make_target f =
@@ -70,7 +70,7 @@ let default_target = make_target 24.
 
 let check_proof_of_work pk nonce target =
   let hash =
-    Hash.Generic_hash.hash_bytes [
+    Blake2B.hash_bytes [
       Sodium.Box.Bigbytes.of_public_key pk ;
       Sodium.Box.Bigbytes.of_nonce nonce ;
     ] in

lib_crypto/crypto_box.mli

@@ -21,7 +21,7 @@ val make_target : float -> target
 
 type secret_key
 type public_key
-module Public_key_hash : Hash.INTERNAL_HASH
+module Public_key_hash : S.INTERNAL_HASH
 type channel_key
 
 val public_key_encoding : public_key Data_encoding.t

lib_crypto/ed25519.ml

@@ -0,0 +1,247 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Public_key_hash = Blake2B.Make(Base58)(struct
+    let name = "Ed25519.Public_key_hash"
+    let title = "An Ed25519 public key ID"
+    let b58check_prefix = Base58.Prefix.ed25519_public_key_hash
+    let size = Some 20
+  end)
+
+let () =
+  Base58.check_encoded_prefix Public_key_hash.b58check_encoding "tz1" 36
+
+module Public_key = struct
+
+  type t = Sodium.Sign.public_key
+  let compare = Sodium.Sign.compare_public_keys
+  let (=) xs ys = compare xs ys = 0
+  let (<>) xs ys = compare xs ys <> 0
+  let (<) xs ys = compare xs ys < 0
+  let (<=) xs ys = compare xs ys <= 0
+  let (>=) xs ys = compare xs ys >= 0
+  let (>) xs ys = compare xs ys > 0
+  let max x y = if x >= y then x else y
+  let min x y = if x <= y then x else y
+
+  type Base58.data +=
+    | Public_key of t
+
+  let b58check_encoding =
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.ed25519_public_key
+      ~length:Sodium.Sign.public_key_size
+      ~to_raw:(fun x -> Bytes.to_string (Sodium.Sign.Bytes.of_public_key x))
+      ~of_raw:(fun x ->
+          try Some (Sodium.Sign.Bytes.to_public_key (Bytes.of_string x))
+          with _ -> None)
+      ~wrap:(fun x -> Public_key x)
+
+  let of_b58check_opt s = Base58.simple_decode b58check_encoding s
+  let of_b58check_exn s =
+    match Base58.simple_decode b58check_encoding s with
+    | Some x -> x
+    | None -> Pervasives.failwith "Unexpected hash (ed25519 public key)"
+  let of_b58check s =
+    match Base58.simple_decode b58check_encoding s with
+    | Some x -> Ok x
+    | None -> generic_error "Unexpected hash (ed25519 public key)"
+  let to_b58check s = Base58.simple_encode b58check_encoding s
+
+  let of_bytes s = Sodium.Sign.Bytes.to_public_key s
+
+  let param ?(name="ed25519-public") ?(desc="Ed25519 public key (b58check-encoded)") t =
+    Cli_entries.(param ~name ~desc (parameter (fun _ str -> Lwt.return (of_b58check str))) t)
+
+  let () =
+    Base58.check_encoded_prefix b58check_encoding "edpk" 54
+
+  let encoding =
+    let open Data_encoding in
+    splitted
+      ~json:
+        (describe
+           ~title: "An Ed25519 public key (Base58Check encoded)" @@
+         conv
+           (fun s -> Base58.simple_encode b58check_encoding s)
+           (fun s ->
+              match Base58.simple_decode b58check_encoding s with
+              | Some x -> x
+              | None -> Data_encoding.Json.cannot_destruct
+                          "Ed25519 public key: unexpected prefix.")
+           string)
+      ~binary:
+        (conv
+           Sodium.Sign.Bigbytes.of_public_key
+           Sodium.Sign.Bigbytes.to_public_key
+           (Fixed.bytes Sodium.Sign.public_key_size))
+
+  let hash v =
+    Public_key_hash.hash_bytes
+      [ Sodium.Sign.Bigbytes.of_public_key v ]
+
+end
+
+module Secret_key = struct
+
+  type t = Sodium.Sign.secret_key
+
+  let to_public_key = Sodium.Sign.secret_key_to_public_key
+
+  type Base58.data +=
+    | Secret_key of t
+
+  let b58check_encoding =
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.ed25519_secret_key
+      ~length:Sodium.Sign.secret_key_size
+      ~to_raw:(fun x -> Bytes.to_string (Sodium.Sign.Bytes.of_secret_key x))
+      ~of_raw:(fun x ->
+          try Some (Sodium.Sign.Bytes.to_secret_key (Bytes.of_string x))
+          with _ -> None)
+      ~wrap:(fun x -> Secret_key x)
+
+  let of_b58check_opt s = Base58.simple_decode b58check_encoding s
+  let of_b58check_exn s =
+    match Base58.simple_decode b58check_encoding s with
+    | Some x -> x
+    | None -> Pervasives.failwith "Unexpected hash (ed25519 secret key)"
+  let of_b58check s =
+    match Base58.simple_decode b58check_encoding s with
+    | Some x -> Ok x
+    | None -> generic_error "Unexpected hash (ed25519 public key)"
+  let to_b58check s = Base58.simple_encode b58check_encoding s
+
+  let of_bytes s = Sodium.Sign.Bytes.to_secret_key s
+
+  let param ?(name="ed25519-secret") ?(desc="Ed25519 secret key (b58check-encoded)") t =
+    Cli_entries.(param ~name ~desc (parameter (fun _ str -> Lwt.return (of_b58check str))) t)
+
+  let () =
+    Base58.check_encoded_prefix b58check_encoding "edsk" 98
+
+  let encoding =
+    let open Data_encoding in
+    splitted
+      ~json:
+        (describe
+           ~title: "An Ed25519 secret key (Base58Check encoded)" @@
+         conv
+           (fun s -> Base58.simple_encode b58check_encoding s)
+           (fun s ->
+              match Base58.simple_decode b58check_encoding s with
+              | Some x -> x
+              | None -> Data_encoding.Json.cannot_destruct
+                          "Ed25519 secret key: unexpected prefix.")
+           string)
+      ~binary:
+        (conv
+           Sodium.Sign.Bigbytes.of_secret_key
+           Sodium.Sign.Bigbytes.to_secret_key
+           (Fixed.bytes Sodium.Sign.secret_key_size))
+
+end
+
+let sign key msg =
+  Sodium.Sign.Bigbytes.(of_signature @@ sign_detached key msg)
+
+module Signature = struct
+
+  type t = MBytes.t
+
+  type Base58.data +=
+    | Signature of t
+
+  let b58check_encoding =
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.ed25519_signature
+      ~length:Sodium.Sign.signature_size
+      ~to_raw:MBytes.to_string
+      ~of_raw:(fun s -> Some (MBytes.of_string s))
+      ~wrap:(fun x -> Signature x)
+
+  let of_b58check_opt s = Base58.simple_decode b58check_encoding s
+  let of_b58check_exn s =
+    match Base58.simple_decode b58check_encoding s with
+    | Some x -> x
+    | None -> Pervasives.failwith "Unexpected hash (ed25519 signature)"
+  let of_b58check s =
+    match Base58.simple_decode b58check_encoding s with
+    | Some x -> Ok x
+    | None -> generic_error "Unexpected hash (ed25519 public key)"
+  let to_b58check s = Base58.simple_encode b58check_encoding s
+
+  let of_bytes s = MBytes.of_string (Bytes.to_string s)
+
+  let param ?(name="signature") ?(desc="Signature (b58check-encoded)") t =
+    Cli_entries.(param ~name ~desc (parameter (fun _ str -> Lwt.return (of_b58check str))) t)
+
+  let () =
+    Base58.check_encoded_prefix b58check_encoding "edsig" 99
+
+  let encoding =
+    let open Data_encoding in
+    splitted
+      ~json:
+        (describe
+           ~title: "An Ed25519 signature (Base58Check encoded)" @@
+         conv
+           (fun s -> Base58.simple_encode b58check_encoding s)
+           (fun s ->
+              match Base58.simple_decode b58check_encoding s with
+              | Some x -> x
+              | None -> Data_encoding.Json.cannot_destruct
+                          "Ed25519 signature: unexpected prefix.")
+           string)
+      ~binary: (Fixed.bytes Sodium.Sign.signature_size)
+
+  let check public_key signature msg =
+    try
+      Sodium.Sign.Bigbytes.(verify public_key (to_signature signature) msg) ;
+      true
+    with _ -> false
+
+  let append key msg =
+    MBytes.concat msg (sign key msg)
+
+  let concat msg signature =
+    MBytes.concat msg signature
+
+end
+
+module Seed = struct
+
+  type t = Sodium.Sign.seed
+
+  let to_hex s =
+    Sodium.Sign.Bytes.of_seed s
+    |> Bytes.to_string
+    |> Hex_encode.hex_encode
+
+  let of_hex s =
+    Hex_encode.hex_decode s
+    |> Bytes.of_string
+    |> Sodium.Sign.Bytes.to_seed
+
+  let generate () =
+    (* Seed is 32 bytes long *)
+    Sodium.Random.Bytes.generate Sodium.Sign.seed_size
+    |> Sodium.Sign.Bytes.to_seed
+
+  let extract =
+    Sodium.Sign.secret_key_to_seed
+end
+
+let generate_key () =
+  let secret, pub = Sodium.Sign.random_keypair () in
+  (Public_key.hash pub, pub, secret)
+
+let generate_seeded_key seed =
+  let secret, pub = Sodium.Sign.seed_keypair seed in
+  (Public_key.hash pub, pub, secret)

lib_crypto/ed25519.mli

@@ -0,0 +1,110 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Tezos - Ed25519 cryptography *)
+
+(** {2 Hashed public keys for user ID} ***************************************)
+
+module Public_key_hash : S.INTERNAL_HASH
+
+(** {2 Signature} ************************************************************)
+
+module Public_key : sig
+
+  include Compare.S
+  val encoding: t Data_encoding.t
+
+  val param:
+    ?name:string ->
+    ?desc:string ->
+    ('a, 'b, 'c) Cli_entries.params ->
+    (t -> 'a, 'b, 'c) Cli_entries.params
+
+  val hash: t -> Public_key_hash.t
+
+  type Base58.data +=
+    | Public_key of t
+
+  val of_b58check: string -> t tzresult
+  val of_b58check_exn: string -> t
+  val of_b58check_opt: string -> t option
+  val to_b58check: t -> string
+
+  val of_bytes: Bytes.t -> t
+
+end
+
+module Secret_key : sig
+
+  type t
+  val encoding: t Data_encoding.t
+
+  val param:
+    ?name:string ->
+    ?desc:string ->
+    ('a, 'b, 'c) Cli_entries.params ->
+    (t -> 'a, 'b, 'c) Cli_entries.params
+
+  val to_public_key: t -> Public_key.t
+
+  type Base58.data +=
+    | Secret_key of t
+
+  val of_b58check: string -> t tzresult
+  val of_b58check_exn: string -> t
+  val of_b58check_opt: string -> t option
+  val to_b58check: t -> string
+
+  val of_bytes: Bytes.t -> t
+
+end
+
+module Signature : sig
+
+  type t
+  val encoding: t Data_encoding.t
+
+  val param:
+    ?name:string ->
+    ?desc:string ->
+    ('a, 'b, 'c) Cli_entries.params ->
+    (t -> 'a, 'b, 'c) Cli_entries.params
+
+  type Base58.data +=
+    | Signature of t
+
+  val of_b58check: string -> t tzresult
+  val of_b58check_exn: string -> t
+  val of_b58check_opt: string -> t option
+  val to_b58check: t -> string
+
+  val of_bytes: Bytes.t -> t
+
+  (** Checks a signature *)
+  val check: Public_key.t -> t -> MBytes.t -> bool
+
+  (** Append a signature *)
+  val append: Secret_key.t -> MBytes.t -> MBytes.t
+  val concat: MBytes.t -> t -> MBytes.t
+
+end
+
+module Seed : sig
+  type t
+  val to_hex : t -> string
+  val of_hex : string -> t
+  val generate : unit -> t
+  val extract : Secret_key.t -> t
+end
+
+val sign: Secret_key.t -> MBytes.t -> Signature.t
+
+val generate_key: unit -> (Public_key_hash.t * Public_key.t * Secret_key.t)
+val generate_seeded_key: Seed.t -> (Public_key_hash.t * Public_key.t * Secret_key.t)
+

lib_crypto/jbuild

@@ -0,0 +1,21 @@
+(jbuild_version 1)
+
+(library
+ ((name tezos_crypto)
+  (public_name tezos-crypto)
+  (flags (:standard -open Tezos_stdlib
+                    -open Tezos_data_encoding
+                    -open Tezos_stdlib_lwt
+                    -open Tezos_error_monad__Error_monad))
+  (libraries (tezos-stdlib
+              tezos-stdlib-lwt
+              tezos-data-encoding
+              tezos-error-monad
+              nocrypto
+              sodium
+              zarith))))
+
+(alias
+ ((name runtest_indent)
+  (deps ((glob_files *.ml) (glob_files *.mli)))
+  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${<}))))

lib_crypto/net_id.ml

@@ -0,0 +1,150 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t = string
+
+let name = "Net_id"
+let title = "Network identifier"
+
+let size = 4
+
+let extract bh =
+  MBytes.substring (Block_hash.to_bytes bh) 0 4
+
+let hash_bytes l = extract (Block_hash.hash_bytes l)
+let hash_string l = extract (Block_hash.hash_string l)
+
+let of_block_hash bh = hash_bytes [Block_hash.to_bytes bh]
+
+type Base58.data += Hash of t
+
+let of_string s =
+  if String.length s <> size then None else Some s
+let of_string_exn s =
+  match of_string s with
+  | None ->
+      let msg =
+        Printf.sprintf "%s.of_string: wrong string size (%d)"
+          name (String.length s) in
+      raise (Invalid_argument msg)
+  | Some h -> h
+let to_string s = s
+
+let of_hex s = of_string (Hex_encode.hex_decode s)
+let of_hex_exn s = of_string_exn (Hex_encode.hex_decode s)
+let to_hex s = Hex_encode.hex_encode (to_string s)
+
+let compare = String.compare
+let equal = String.equal
+
+let of_bytes b =
+  if MBytes.length b <> size then
+    None
+  else
+    Some (MBytes.to_string b)
+let of_bytes_exn b =
+  match of_bytes b with
+  | None ->
+      let msg =
+        Printf.sprintf "%s.of_bytes: wrong string size (%d)"
+          name (MBytes.length b) in
+      raise (Invalid_argument msg)
+  | Some h -> h
+let to_bytes = MBytes.of_string
+
+let read src off = of_bytes_exn @@ MBytes.sub src off size
+let write dst off h = MBytes.blit (to_bytes h) 0 dst off size
+
+let b58check_encoding =
+  Base58.register_encoding
+    ~prefix: Base58.Prefix.net_id
+    ~length: size
+    ~wrap: (fun s -> Hash s)
+    ~of_raw:of_string ~to_raw: (fun h -> h)
+
+let of_b58check_opt s =
+  Base58.simple_decode b58check_encoding s
+let of_b58check_exn s =
+  match Base58.simple_decode b58check_encoding s with
+  | Some x -> x
+  | None -> Format.kasprintf Pervasives.failwith "Unexpected hash (%s)" name
+let of_b58check s =
+  match Base58.simple_decode b58check_encoding s with
+  | Some x -> Ok x
+  | None -> generic_error "Unexpected hash (%s)" name
+let to_b58check s = Base58.simple_encode b58check_encoding s
+let to_short_b58check = to_b58check
+
+let encoding =
+  let open Data_encoding in
+  splitted
+    ~binary: (Fixed.string size)
+    ~json:
+      (describe ~title: (title ^ " (Base58Check-encoded Blake2B hash)") @@
+       conv to_b58check (Data_encoding.Json.wrap_error of_b58check_exn) string)
+
+let param ?(name=name) ?(desc=title) t =
+  Cli_entries.(param ~name ~desc (parameter (fun _ str -> Lwt.return (of_b58check str))) t)
+
+let pp ppf t =
+  Format.pp_print_string ppf (to_b58check t)
+
+let pp_short ppf t =
+  Format.pp_print_string ppf (to_short_b58check t)
+
+module Set = struct
+  include Set.Make(struct type nonrec t = t let compare = compare end)
+  exception Found of elt
+  let random_elt s =
+    let n = Random.int (cardinal s) in
+    try
+      ignore
+        (fold (fun x i -> if i = n then raise (Found x) ; i+1) s 0 : int) ;
+      assert false
+    with Found x -> x
+  let encoding =
+    Data_encoding.conv
+      elements
+      (fun l -> List.fold_left (fun m x -> add x m) empty l)
+      Data_encoding.(list encoding)
+end
+let random_set_elt = Set.random_elt
+
+module Map = struct
+  include Map.Make(struct type nonrec t = t let compare = compare end)
+  let encoding arg_encoding =
+    Data_encoding.conv
+      bindings
+      (fun l -> List.fold_left (fun m (k,v) -> add k v m) empty l)
+      Data_encoding.(list (tup2 encoding arg_encoding))
+end
+
+let path_length = 1
+let to_path key l = to_hex key :: l
+let of_path path =
+  let path = String.concat "" path in
+  of_hex path
+let of_path_exn path =
+  let path = String.concat "" path in
+  of_hex_exn path
+
+let prefix_path p =
+  let p = Hex_encode.hex_encode p in
+  [ p ]
+
+module Table = struct
+  include Hashtbl.Make(struct
+      type nonrec t = t
+      let hash = Hashtbl.hash
+      let equal = equal
+    end)
+end
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "Net" 15

lib_crypto/net_id.mli

@@ -0,0 +1,11 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include S.INTERNAL_HASH
+val of_block_hash: Block_hash.t -> t

lib_crypto/operation_hash.ml

@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include Blake2B.Make (Base58) (struct
+    let name = "Operation_hash"
+    let title = "A Tezos operation ID"
+    let b58check_prefix = Base58.Prefix.operation_hash
+    let size = None
+  end)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "o" 51
+

lib_crypto/operation_hash.mli

@@ -0,0 +1,10 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include S.INTERNAL_HASH

lib_crypto/operation_list_hash.ml

@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include Blake2B.Make_merkle_tree (Base58) (struct
+    let name = "Operation_list_hash"
+    let title = "A list of operations"
+    let b58check_prefix = Base58.Prefix.operation_list_hash
+    let size = None
+  end) (Operation_hash)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "Lo" 52

lib_crypto/operation_list_hash.mli

@@ -0,0 +1,11 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include S.INTERNAL_MERKLE_TREE with type elt = Operation_hash.t
+

lib_crypto/operation_list_list_hash.ml

@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include Blake2B.Make_merkle_tree (Base58) (struct
+    let name = "Operation_list_list_hash"
+    let title = "A list of list of operations"
+    let b58check_prefix = Base58.Prefix.operation_list_list_hash
+    let size = None
+  end) (Operation_list_hash)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "LLo" 53 ;

lib_crypto/operation_list_list_hash.mli

@@ -0,0 +1,10 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include S.INTERNAL_MERKLE_TREE with type elt = Operation_list_hash.t

lib_crypto/protocol_hash.ml

@@ -0,0 +1,19 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include Blake2B.Make (Base58) (struct
+    let name = "Protocol_hash"
+    let title = "A Tezos protocol ID"
+    let b58check_prefix = Base58.Prefix.protocol_hash
+    let size = None
+  end)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "P" 51
+

lib_crypto/protocol_hash.mli

@@ -0,0 +1,10 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+include S.INTERNAL_HASH

lib_crypto/s.ml

@@ -7,10 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Error_monad
-
-(** Tezos - Manipulation and creation of hashes *)
-
 
 (** {2 Hash Types} ************************************************************)
 
@@ -144,61 +140,3 @@ module type PrefixedName = sig
   include Name
   val b58check_prefix : string
 end
-
-(** Builds a new Hash type using Blake2B. *)
-module Make_minimal_Blake2B (Name : Name) : INTERNAL_MINIMAL_HASH
-module Make_Blake2B
-    (Register : sig
-       val register_encoding:
-         prefix: string ->
-         length: int ->
-         to_raw: ('a -> string) ->
-         of_raw: (string -> 'a option) ->
-         wrap: ('a -> Base58.data) ->
-         'a Base58.encoding
-     end)
-    (Name : PrefixedName) : INTERNAL_HASH
-
-(** {2 Predefined Hashes } ****************************************************)
-
-(** Blocks hashes / IDs. *)
-module Block_hash : INTERNAL_HASH
-
-(** Operations hashes / IDs. *)
-module Operation_hash : INTERNAL_HASH
-
-(** List of operations hashes / IDs. *)
-module Operation_list_hash :
-  INTERNAL_MERKLE_TREE with type elt = Operation_hash.t
-
-module Operation_list_list_hash :
-  INTERNAL_MERKLE_TREE with type elt = Operation_list_hash.t
-
-(** Protocol versions / source hashes. *)
-module Protocol_hash : INTERNAL_HASH
-
-module Net_id : sig
-  include INTERNAL_HASH
-  val of_block_hash: Block_hash.t -> t
-end
-
-module Generic_hash : INTERNAL_MINIMAL_HASH
-
-(**/**)
-
-module Generic_Merkle_tree (H : sig
-    type t
-    type elt
-    val encoding : t Data_encoding.t
-    val empty : t
-    val leaf : elt -> t
-    val node : t -> t -> t
-  end) : sig
-  val compute : H.elt list -> H.t
-  type path =
-    | Left of path * H.t
-    | Right of H.t * path
-    | Op
-  val compute_path: H.elt list -> int -> path
-  val check_path: path -> H.elt -> H.t * int
-end

lib_crypto/tezos-crypto.opam

@@ -0,0 +1,21 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "https://gitlab.com/tezos/tezos.git"
+license: "unreleased"
+depends: [
+  "ocamlfind" { build }
+  "jbuilder" { build & >= "1.0+beta15" }
+  "base-bigarray"
+  "tezos-base"
+  "lwt"
+]
+build: [
+  [ "jbuilder" "build" "-p" name "-j" jobs ]
+]
+build-test: [
+  [ "jbuilder" "runtest" "-p" name "-j" jobs ]
+]

lib_data_encoding/data_encoding.ml

@@ -227,7 +227,7 @@ module Json = struct
         int32
         (fun i ->
            let j = Int64.to_int32 i in
-           if Compare.Int64.(=) (Int64.of_int32 j) i then Some j else None)
+           if Int64.equal (Int64.of_int32 j) i then Some j else None)
         Int64.of_int32 ;
       case
         string
@@ -770,8 +770,8 @@ module Binary = struct
           | Case { tag = None } -> None
           | Case { encoding = e ; proj ; tag = Some _ } ->
               let length v = tag_size sz + length e v in
-              Some (fun v -> Utils.map_option ~f:length (proj v)) in
+              Some (fun v -> Option.map ~f:length (proj v)) in
-        apply (Utils.filter_map case_length cases)
+        apply (TzList.filter_map case_length cases)
     | Mu (`Dynamic, _name, self) ->
         fun v -> length (self e) v
     | Obj (Opt (`Dynamic, _, e)) ->
@@ -820,7 +820,7 @@ module Binary = struct
                   match proj v with
                   | None -> None
                   | Some v -> Some (length v)) in
-        apply (Utils.filter_map case_length cases)
+        apply (TzList.filter_map case_length cases)
     | Mu (`Variable, _name, self) ->
         fun v -> length (self e) v
     (* Recursive*)
@@ -1132,7 +1132,7 @@ module Binary = struct
 
     let union r sz cases =
       let read_cases =
-        Utils.filter_map
+        TzList.filter_map
           (function
             | (Case { tag = None }) -> None
             | (Case { encoding = e ; inj ; tag = Some tag }) ->

lib_data_encoding/jbuild

@@ -0,0 +1,14 @@
+(jbuild_version 1)
+
+(library
+ ((name tezos_data_encoding)
+  (public_name tezos-data-encoding)
+  (libraries (tezos-stdlib ocplib-json-typed ocplib-json-typed.bson))
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
+                    -open Tezos_stdlib))))
+
+(alias
+ ((name runtest_indent)
+  (deps ((glob_files *.ml) (glob_files *.mli)))
+  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${<}))))

lib_data_encoding/tezos-data-encoding.install

@@ -0,0 +1,26 @@
+lib: [
+  "_build/install/default/lib/tezos-data-encoding/META" {"META"}
+  "_build/install/default/lib/tezos-data-encoding/opam" {"opam"}
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding__Data_encoding.cmi"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding__Data_encoding.cmx"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding__Data_encoding.cmt"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding__Data_encoding.cmti"
+  "_build/install/default/lib/tezos-data-encoding/data_encoding.mli"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding__Hex_encode.cmi"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding__Hex_encode.cmx"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding__Hex_encode.cmt"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding__Hex_encode.cmti"
+  "_build/install/default/lib/tezos-data-encoding/hex_encode.mli"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding.cmi"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding.cmx"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding.cmt"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding.ml-gen"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding.cma"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding.cmxa"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding.a"
+  "_build/install/default/lib/tezos-data-encoding/tezos_data_encoding.cmxs"
+]
+doc: [
+  "_build/install/default/doc/tezos-data-encoding/README.md"
+  "_build/install/default/doc/tezos-data-encoding/CHANGES.alphanet"
+]

lib_data_encoding/tezos-data-encoding.opam

@@ -0,0 +1,23 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "https://gitlab.com/tezos/tezos.git"
+license: "unreleased"
+depends: [
+  "ocamlfind" { build }
+  "jbuilder" { build & >= "1.0+beta15" }
+  "base-bigarray"
+  "tezos-stdlib"
+  "ocplib-json-typed"
+  "ocplib-endian"
+  "js_of_ocaml"
+]
+build: [
+  [ "jbuilder" "build" "-p" name "-j" jobs ]
+]
+build-test: [
+  [ "jbuilder" "runtest" "-p" name "-j" jobs ]
+]

lib_error_monad/error_monad.ml

@@ -55,7 +55,7 @@ module Make() = struct
       category ~id:name ~title ~description ?pp
       encoding from_error to_error =
     if List.exists
-        (fun (Error_kind { id }) -> name = id)
+        (fun (Error_kind { id ; _ }) -> name = id)
         !error_kinds then
       invalid_arg
         (Printf.sprintf
@@ -77,7 +77,7 @@ module Make() = struct
                    category ;
                    from_error ;
                    encoding_case ;
-                   pp = Utils.unopt ~default:(json_pp name encoding) pp } :: !error_kinds
+                   pp = Option.unopt ~default:(json_pp name encoding) pp } :: !error_kinds
 
   let register_wrapped_error_kind
       category ~id ~title ~description ?pp
@@ -100,7 +100,7 @@ module Make() = struct
     | None ->
         let cases =
           List.map
-            (fun (Error_kind { encoding_case }) -> encoding_case )
+            (fun (Error_kind { encoding_case ; _ }) -> encoding_case )
             !error_kinds in
         let json_encoding = Data_encoding.union cases in
         let encoding =
@@ -127,7 +127,7 @@ module Make() = struct
     let rec find e = function
       | [] -> `Temporary
       (* assert false (\* See "Generic error" *\) *)
-      | Error_kind { from_error ; category } :: rest ->
+      | Error_kind { from_error ; category ; _ } :: rest ->
           match from_error e with
           | Some x -> begin
               match category with
@@ -148,15 +148,12 @@ module Make() = struct
   let pp ppf error =
     let rec find = function
       | [] -> assert false (* See "Generic error" *)
-      | Error_kind { from_error ; pp } :: errors ->
+      | Error_kind { from_error ; pp ; _ } :: errors ->
           match from_error error with
           | None -> find errors
           | Some x -> pp ppf x in
     find !error_kinds
 
-  let registred_errors () = !error_kinds
-
-
   (*-- Monad definition --------------------------------------------------------*)
 
   let (>>=) = Lwt.(>>=)

lib_error_monad/jbuild

@@ -0,0 +1,15 @@
+(jbuild_version 1)
+
+(library
+ ((name tezos_error_monad)
+  (public_name tezos-error-monad)
+  (flags (:standard -open Tezos_stdlib
+                    -open Tezos_data_encoding))
+  (libraries (tezos-stdlib
+              tezos-data-encoding
+              lwt))))
+
+(alias
+ ((name runtest_indent)
+  (deps ((glob_files *.ml) (glob_files *.mli)))
+  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${<}))))

lib_error_monad/tezos-error-monad.opam

@@ -0,0 +1,21 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "https://gitlab.com/tezos/tezos.git"
+license: "unreleased"
+depends: [
+  "ocamlfind" { build }
+  "jbuilder" { build & >= "1.0+beta15" }
+  "base-bigarray"
+  "tezos-stdlib"
+  "tezos-data-encoding"
+]
+build: [
+  [ "jbuilder" "build" "-p" name "-j" jobs ]
+]
+build-test: [
+  [ "jbuilder" "runtest" "-p" name "-j" jobs ]
+]

lib_stdlib/jbuild

@@ -0,0 +1,15 @@
+(jbuild_version 1)
+
+(library
+ ((name tezos_stdlib)
+  (public_name tezos-stdlib)
+  (libraries (ocplib-endian.bigstring cstruct stringext))))
+
+(alias
+ ((name runtest_indent)
+  (deps ((glob_files *.ml) (glob_files *.mli)))
+  (action (run bash ${path:test-ocp-indent.sh} ${<}))))
+
+(install
+ ((section libexec)
+  (files ((test-ocp-indent.sh as test-ocp-indent.sh)))))

lib_stdlib/mBytes.ml

@@ -33,7 +33,7 @@ external unsafe_blit_bigstring_to_bytes
   = "caml_blit_bigstring_to_string" [@@noalloc]
 
 (** HACK: force Cstruct at link which provides the previous primitives. *)
-let dummy = Cstruct.byte_to_int
+let _dummy = Cstruct.byte_to_int
 
 let invalid_bounds j l =
   invalid_arg (Printf.sprintf "invalid bounds (index %d, length %d)" j l)

lib_stdlib/option.ml

@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+let map ~f = function
+  | None -> None
+  | Some x -> Some (f x)
+
+let apply ~f = function
+  | None -> None
+  | Some x -> f x
+
+let iter ~f = function
+  | None -> ()
+  | Some x -> f x
+
+let unopt ~default = function
+  | None -> default
+  | Some x -> x
+
+let unopt_map ~f ~default = function
+  | None -> default
+  | Some x -> f x
+
+let first_some a b = match a, b with
+  | None, None -> None
+  | None, Some v -> Some v
+  | Some v, _ -> Some v
+

lib_stdlib/option.mli

@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** [Some (f x)] if input is [Some x], or [None] if it's [None] **)
+val map: f:('a -> 'b) -> 'a option -> 'b option
+
+(** [(f x)] if input is [Some x], or [None] if it's [None] **)
+val apply: f:('a -> 'b option) -> 'a option -> 'b option
+
+(** Call [(f x)] if input is [Some x], noop if it's [None] **)
+val iter: f:('a -> unit) -> 'a option -> unit
+
+(** [x] if input is [Some x], default if it's [None] **)
+val unopt: default:'a -> 'a option -> 'a
+
+(** [unopt_map f d x] is [y] if [x] is [Some y], [d] if [x] is [None] **)
+val unopt_map: f:('a -> 'b) -> default:'b -> 'a option -> 'b
+
+(** First input of form [Some x], or [None] if none **)
+val first_some: 'a option -> 'a option -> 'a option
+

lib_stdlib/test-ocp-indent.sh

@@ -2,13 +2,21 @@
 
 tmp_dir="$(mktemp -d -t tezos_build.XXXXXXXXXX)"
 failed=no
-fix=${1:-""}
+if [ "$1" = "fix" ]; then
+    fix=yes
+    shift 1
+fi
 
-for f in  ` find \( -name _build -or \
+files="$@"
-                    -name .git -or \
+if [ -z "$files" ]; then
-                    -wholename ./src/environment/v1.ml -or \
+files=` find \( -name _build -or \
-                    -name registerer.ml \) -prune -or \
+                -name .git -or \
-                 \( -name \*.ml -or -name \*.mli \) -print`; do
+                -wholename ./src/environment/v1.ml -or \
+                -name registerer.ml \) -prune -or \
+                \( -name \*.ml -or -name \*.mli \) -print`
+fi
+
+for f in $files ; do
   ff=$(basename $f)
   ocp-indent $f > $tmp_dir/$ff
   diff -U 3 $f $tmp_dir/$ff

lib_stdlib/tezos-base.install

@@ -0,0 +1,29 @@
+lib: [
+  "_build/install/default/lib/tezos-base/META" {"META"}
+  "_build/install/default/lib/tezos-base/opam" {"opam"}
+  "_build/install/default/lib/tezos-base/tezos_base__MBytes.cmi"
+  "_build/install/default/lib/tezos-base/tezos_base__MBytes.cmx"
+  "_build/install/default/lib/tezos-base/tezos_base__MBytes.cmt"
+  "_build/install/default/lib/tezos-base/tezos_base__MBytes.cmti"
+  "_build/install/default/lib/tezos-base/mBytes.mli"
+  "_build/install/default/lib/tezos-base/tezos_base.cmi"
+  "_build/install/default/lib/tezos-base/tezos_base.cmx"
+  "_build/install/default/lib/tezos-base/tezos_base.cmt"
+  "_build/install/default/lib/tezos-base/tezos_base.ml-gen"
+  "_build/install/default/lib/tezos-base/tezos_base__Utils.cmi"
+  "_build/install/default/lib/tezos-base/tezos_base__Utils.cmx"
+  "_build/install/default/lib/tezos-base/tezos_base__Utils.cmt"
+  "_build/install/default/lib/tezos-base/tezos_base__Utils.cmti"
+  "_build/install/default/lib/tezos-base/utils.mli"
+  "_build/install/default/lib/tezos-base/tezos_base.cma"
+  "_build/install/default/lib/tezos-base/tezos_base.cmxa"
+  "_build/install/default/lib/tezos-base/tezos_base.a"
+  "_build/install/default/lib/tezos-base/tezos_base.cmxs"
+]
+libexec: [
+  "_build/install/default/lib/tezos-base/test-ocp-indent.sh" {"test-ocp-indent.sh"}
+]
+doc: [
+  "_build/install/default/doc/tezos-base/README.md"
+  "_build/install/default/doc/tezos-base/CHANGES.alphanet"
+]

lib_stdlib/tezos-stdlib.opam

@@ -0,0 +1,22 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "https://gitlab.com/tezos/tezos.git"
+license: "unreleased"
+depends: [
+  "ocamlfind" { build }
+  "jbuilder" { build & >= "1.0+beta15" }
+  "base-bigarray"
+  "cstruct"
+  "ocplib-endian.bigstring"
+  "stringext"
+]
+build: [
+  [ "jbuilder" "build" "-p" name "-j" jobs ]
+]
+build-test: [
+  [ "jbuilder" "runtest" "-p" name "-j" jobs ]
+]

lib_stdlib/tzList.ml

@@ -0,0 +1,135 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+let may_cons xs x = match x with None -> xs | Some x -> x :: xs
+
+let filter_map f l =
+  List.rev @@ List.fold_left (fun acc x -> may_cons acc (f x)) [] l
+
+let rev_sub l n =
+  if n < 0 then
+    invalid_arg "Utils.rev_sub: `n` must be non-negative.";
+  let rec append_rev_sub acc l = function
+    | 0 -> acc
+    | n ->
+        match l with
+        | [] -> acc
+        | hd :: tl -> append_rev_sub (hd :: acc) tl (n - 1) in
+  append_rev_sub [] l n
+
+let sub l n = rev_sub l n |> List.rev
+
+let hd_opt = function
+  | [] -> None
+  | h :: _ -> Some h
+
+let rec last_exn = function
+  | [] -> raise Not_found
+  | [x] -> x
+  | _ :: xs -> last_exn xs
+
+let merge_filter2
+    ?(finalize = List.rev) ?(compare = compare)
+    ?(f = Option.first_some)
+    l1 l2 =
+  let sort = List.sort compare in
+  let rec merge_aux acc = function
+    | [], [] -> finalize acc
+    | r1, [] -> finalize acc @ (filter_map (fun x1 -> f (Some x1) None) r1)
+    | [], r2 -> finalize acc @ (filter_map (fun x2 -> f None (Some x2)) r2)
+    | ((h1 :: t1) as r1), ((h2 :: t2) as r2) ->
+        if compare h1 h2 > 0 then
+          merge_aux (may_cons acc (f None (Some h2))) (r1, t2)
+        else if compare h1 h2 < 0 then
+          merge_aux (may_cons acc (f (Some h1) None)) (t1, r2)
+        else (* m1 = m2 *)
+          merge_aux (may_cons acc (f (Some h1) (Some h2))) (t1, t2)
+  in
+  merge_aux [] (sort l1, sort l2)
+
+let merge2 ?finalize ?compare ?(f = fun x1 _x1 -> x1) l1 l2 =
+  merge_filter2 ?finalize ?compare
+    ~f:(fun x1 x2 -> match x1, x2 with
+        | None, None -> assert false
+        | Some x1, None -> Some x1
+        | None, Some x2 -> Some x2
+        | Some x1, Some x2 -> Some (f x1 x2))
+    l1 l2
+
+let rec remove nb = function
+  | [] -> []
+  | l when nb <= 0 -> l
+  | _ :: tl -> remove (nb - 1) tl
+
+let rec repeat n x = if n <= 0 then [] else x :: repeat (pred n) x
+
+let take_n_unsorted n l =
+  let rec loop acc n = function
+    | [] -> l
+    | _ when n <= 0 -> List.rev acc
+    | x :: xs -> loop (x :: acc) (pred n) xs in
+  loop [] n l
+
+module Bounded(E: Set.OrderedType) : sig
+
+  type t
+  val create: int -> t
+  val insert: E.t -> t -> unit
+  val get: t -> E.t list
+
+end = struct
+
+  (* TODO one day replace the list by an heap array *)
+
+  type t = {
+    bound : int ;
+    mutable size : int ;
+    mutable data : E.t list ;
+  }
+
+  let create bound =
+    if bound <= 0 then invalid_arg "Utils.Bounded(_).create" ;
+    { bound ; size = 0 ; data = [] }
+
+  let rec push x = function
+    | [] -> [x]
+    | (y :: xs) as ys ->
+        if E.compare x y <= 0
+        then x :: ys
+        else y :: push x xs
+
+  let insert x t =
+    if t.size < t.bound then begin
+      t.size <- t.size + 1 ;
+      t.data <- push x t.data
+    end else if E.compare (List.hd t.data) x < 0 then
+      t.data <- push x (List.tl t.data)
+
+  let get { data ; _ } = data
+
+end
+
+let take_n_sorted (type a) compare n l =
+  let module B = Bounded(struct type t = a let compare = compare end) in
+  let t = B.create n in
+  List.iter (fun x -> B.insert x t) l ;
+  B.get t
+
+let take_n ?compare n l =
+  match compare with
+  | None -> take_n_unsorted n l
+  | Some compare -> take_n_sorted compare n l
+
+let select n l =
+  let rec loop n acc = function
+    | [] -> invalid_arg "Utils.select"
+    | x :: xs when n <= 0 -> x, List.rev_append acc xs
+    | x :: xs -> loop (pred n) (x :: acc) xs
+  in
+  loop n [] l

lib_stdlib/tzList.mli

@@ -0,0 +1,65 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** [remove nb list] remove the first [nb] elements from the list [list]. *)
+val remove: int -> 'a list -> 'a list
+
+(** [repeat n x] is a list of [n] [x]'s **)
+val repeat: int -> 'a -> 'a list
+
+(** [take_n n l] returns the [n] first elements of [l]. When [compare]
+    is provided, it returns the [n] greatest element of [l]. *)
+val take_n: ?compare:('a -> 'a -> int) -> int -> 'a list -> 'a list
+
+(** Bounded sequence: keep only the [n] greatest elements. *)
+module Bounded(E: Set.OrderedType) : sig
+  type t
+  val create: int -> t
+  val insert: E.t -> t -> unit
+  val get: t -> E.t list
+end
+
+(** [select n l] is ([n]th element of [l], [l] without that element) **)
+val select: int -> 'a list -> 'a * 'a list
+
+
+(** [filter_map f l] is [[y for x in l where (f x) = Some y]] **)
+val filter_map: ('a -> 'b option) -> 'a list -> 'b list
+
+(** [rev_sub l n] is [List.rev l] capped to max [n] elements *)
+val rev_sub : 'a list -> int -> 'a list
+
+(** [sub l n] is [l] capped to max [n] elements *)
+val sub: 'a list -> int -> 'a list
+
+(** Like [List.hd], but [Some hd] or [None] if empty **)
+val hd_opt: 'a list -> 'a option
+
+(** Last elt of list, or raise Not_found if empty **)
+val last_exn: 'a list -> 'a
+
+(** [merge_filter2 ~compare ~f l1 l2] merges two lists ordered by [compare]
+    and whose items can be merged with [f]. Item is discarded or kept whether
+    [f] returns [Some] or [None] *)
+val merge_filter2 :
+  ?finalize:('a list -> 'a list) ->
+  ?compare:('a -> 'a -> int) ->
+  ?f:('a option -> 'a option -> 'a option) ->
+  'a list -> 'a list ->
+  'a list
+
+(** [merge2 ~compare ~f l1 l2] merges two lists ordered by [compare] and
+    whose items can be merged with [f] *)
+val merge2 :
+  ?finalize:('a list -> 'a list) ->
+  ?compare:('a -> 'a -> int) ->
+  ?f:('a -> 'a -> 'a) ->
+  'a list -> 'a list ->
+  'a list
+

lib_stdlib/tzString.ml

@@ -0,0 +1,75 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Map = Map.Make (String)
+
+let split delim ?(dup = true) ?(limit = max_int) path =
+  let l = String.length path in
+  let rec do_slashes acc limit i =
+    if i >= l then
+      List.rev acc
+    else if String.get path i = delim then
+      if dup then
+        do_slashes acc limit (i + 1)
+      else
+        do_split acc limit (i + 1)
+    else
+      do_split acc limit i
+  and do_split acc limit i =
+    if limit <= 0 then
+      if i = l then
+        List.rev acc
+      else
+        List.rev (String.sub path i (l - i) :: acc)
+    else
+      do_component acc (pred limit) i i
+  and do_component acc limit i j =
+    if j >= l then
+      if i = j then
+        List.rev acc
+      else
+        List.rev (String.sub path i (j - i) :: acc)
+    else if String.get path j = delim then
+      do_slashes (String.sub path i (j - i) :: acc) limit j
+    else
+      do_component acc limit i (j + 1) in
+  if limit > 0 then
+    do_slashes [] limit 0
+  else
+    [ path ]
+
+let split_path path = split '/' path
+
+let has_prefix ~prefix s =
+  let x = String.length prefix in
+  let n = String.length s in
+  n >= x && String.sub s 0 x = prefix
+
+let remove_prefix ~prefix s =
+  let x = String.length prefix in
+  let n = String.length s in
+  if n >= x && String.sub s 0 x = prefix then
+    Some (String.sub s x (n - x))
+  else
+    None
+
+let common_prefix s1 s2 =
+  let last = min (String.length s1) (String.length s2) in
+  let rec loop i =
+    if last <= i then last
+    else if s1.[i] = s2.[i] then
+      loop (i+1)
+    else
+      i in
+  loop 0
+
+let mem_char s c =
+  match String.index s c with
+  | exception Not_found -> false
+  | _ -> true

lib_stdlib/tzString.mli

@@ -0,0 +1,31 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Map : Map.S with type key = string
+
+(** Splits a string on slashes, grouping multiple slashes, and
+    ignoring slashes at the beginning and end of string. *)
+val split_path: string -> string list
+
+(** Splits a string on a delimier character, grouping multiple
+    delimiters, and ignoring delimiters at the beginning and end of
+    string, if [limit] is passed, stops after [limit] split(s). *)
+val split: char -> ?dup:bool -> ?limit: int -> string -> string list
+
+(** [true] if input has prefix **)
+val has_prefix: prefix:string -> string -> bool
+
+(** Some (input with [prefix] removed), if string has [prefix], else [None] **)
+val remove_prefix: prefix:string -> string -> string option
+
+(** Length of common prefix of input strings *)
+val common_prefix: string -> string -> int
+
+(** Test whether a string contains a given character *)
+val mem_char: string -> char -> bool

lib_stdlib/utils.ml

@@ -0,0 +1,61 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Infix = struct
+
+  let (<<) g f = fun a -> g (f a)
+
+  let (--) i j =
+    let rec loop acc j =
+      if j < i then acc else loop (j :: acc) (pred j) in
+    loop [] j
+
+end
+
+let display_paragraph ppf description =
+  Format.fprintf ppf "@[%a@]"
+    (Format.pp_print_list ~pp_sep:Format.pp_print_newline
+       (fun ppf line ->
+          Format.pp_print_list ~pp_sep:Format.pp_print_space
+            (fun ppf w ->
+               (* replace &nbsp; by real spaces... *)
+               Format.fprintf ppf "%s@ "
+                 (Stringext.replace_all ~pattern:"\xC2\xA0" ~with_:" " w))
+            ppf
+            (TzString.split ' ' line)))
+    (TzString.split ~dup:false '\n' description)
+
+let finalize f g = try let res = f () in g (); res with exn -> g (); raise exn
+
+let read_file ?(bin=false) fn =
+  let ic = (if bin then open_in_bin else open_in) fn in
+  finalize (fun () ->
+      let len = in_channel_length ic in
+      really_input_string ic len)
+    (fun () -> close_in ic)
+
+let write_file ?(bin=false) fn contents =
+  let oc = (if bin then open_out_bin else open_out) fn in
+  finalize (fun () ->
+      let contents = Bytes.unsafe_of_string contents in
+      output oc contents 0 @@ Bytes.length contents
+    )
+    (fun () -> close_out oc)
+
+let mkdir dir =
+  let safe_mkdir dir =
+    if not (Sys.file_exists dir) then
+      try Unix.mkdir dir 0o755
+      with Unix.Unix_error(Unix.EEXIST,_,_) -> () in
+  let rec aux dir =
+    if not (Sys.file_exists dir) then begin
+      aux (Filename.dirname dir);
+      safe_mkdir dir;
+    end in
+  aux dir

lib_stdlib/utils.mli

@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Infix : sig
+
+  (** Compose functions from right to left. *)
+  val (<<) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c
+
+  (** Sequence: [i--j] is the sequence [i;i+1;...;j-1;j] *)
+  val (--) : int -> int -> int list
+
+end
+
+(** Print a paragraph in a box **)
+val display_paragraph: Format.formatter -> string -> unit
+
+(** [finalize f g ] ensures g() called after f(), even if exception raised **)
+val finalize: (unit -> 'a) -> (unit -> unit) -> 'a
+
+(** Return contents of file at given filename. **)
+val read_file: ?bin:bool -> string -> string
+
+(** [write_file p c] writes c to file at path p **)
+val write_file: ?bin:bool -> string -> string -> unit
+
+val mkdir: string -> unit

lib_stdlib_lwt/cli_entries.ml

@@ -10,8 +10,6 @@
 (* Tezos Command line interface - Command Line Parsing *)
 
 open Error_monad
-open Lwt.Infix
-open Utils
 
 (* User catchable exceptions *)
 type error += Bad_argument of int * string
@@ -59,14 +57,14 @@ type ('a, 'arg) args =
     ('a * 'b, 'args) args
 
 let parse_arg :
-  type a ctx. (a, ctx) arg -> string option StringMap.t -> ctx -> a tzresult Lwt.t =
+  type a ctx. (a, ctx) arg -> string option TzString.Map.t -> ctx -> a tzresult Lwt.t =
   fun spec args_dict ctx ->
     match spec with
     | Arg { parameter ; kind={ converter } } ->
         begin
           try
             begin
-              match StringMap.find parameter args_dict with
+              match TzString.Map.find parameter args_dict with
               | None -> return None
               | Some s ->
                   (converter ctx s) >>|? fun x ->
@@ -85,17 +83,17 @@ let parse_arg :
                    "Value provided as default for '%s' could not be parsed by converter function."
                    parameter) end >>=? fun default ->
         begin try
-            match StringMap.find parameter args_dict with
+            match TzString.Map.find parameter args_dict with
             | None -> return default
             | Some s -> converter ctx s
           with Not_found -> return default
         end
     | Switch { parameter } ->
-        return (StringMap.mem parameter args_dict)
+        return (TzString.Map.mem parameter args_dict)
 
 (* Argument parsing *)
 let rec parse_args :
-  type a ctx. (a, ctx) args -> string option StringMap.t -> ctx -> a tzresult Lwt.t =
+  type a ctx. (a, ctx) args -> string option TzString.Map.t -> ctx -> a tzresult Lwt.t =
   fun spec args_dict ctx ->
     match spec with
     | NoArgs -> return ()
@@ -104,15 +102,15 @@ let rec parse_args :
         parse_args rest args_dict ctx >>|? fun rest ->
         (arg, rest)
 
-let empty_args_dict = StringMap.empty
+let empty_args_dict = TzString.Map.empty
 
 let rec make_arities_dict :
-  type a b. int StringMap.t -> (a, b) args -> int StringMap.t =
+  type a b. int TzString.Map.t -> (a, b) args -> int TzString.Map.t =
   fun acc -> function
     | NoArgs -> acc
     | AddArg (arg, rest) ->
         let recur parameter num =
-          make_arities_dict (StringMap.add parameter num acc) rest in
+          make_arities_dict (TzString.Map.add parameter num acc) rest in
         begin
           match arg with
           | Arg { parameter } -> recur parameter 1
@@ -136,13 +134,13 @@ let make_args_dict_consume help_flag ignore_autocomplete spec args =
         make_args_dict true arities acc remaining_args >>=? fun (dict, _) ->
         return (dict, "bash_autocomplete" :: prev_arg :: cur_arg :: script :: remaining_args)
     | arg :: tl ->
-        if StringMap.mem arg arities
+        if TzString.Map.mem arg arities
-        then let arity = StringMap.find arg arities in
+        then let arity = TzString.Map.find arg arities in
           check_help_flag help_flag tl >>=? fun () ->
           match arity, tl with
-          | 0, tl' -> make_args_dict completing arities (StringMap.add arg None acc) tl'
+          | 0, tl' -> make_args_dict completing arities (TzString.Map.add arg None acc) tl'
           | 1, value :: tl' ->
-              make_args_dict completing arities (StringMap.add arg (Some value) acc) tl'
+              make_args_dict completing arities (TzString.Map.add arg (Some value) acc) tl'
           | 1, [] when completing ->
               return (acc, [])
           | 1, [] ->
@@ -150,7 +148,7 @@ let make_args_dict_consume help_flag ignore_autocomplete spec args =
           | _, _ ->
               raise (Failure "cli_entries: Arguments with arity not equal to 1 or 0 not supported")
         else return (acc, args)
-  in make_args_dict false (make_arities_dict StringMap.empty spec) StringMap.empty args
+  in make_args_dict false (make_arities_dict TzString.Map.empty spec) TzString.Map.empty args
 
 let make_args_dict_filter help_flag spec args =
   let rec make_args_dict arities (dict, other_args) args =
@@ -158,19 +156,19 @@ let make_args_dict_filter help_flag spec args =
     match args with
     | [] -> return (dict, other_args)
     | arg :: tl ->
-        if StringMap.mem arg arities
+        if TzString.Map.mem arg arities
-        then let arity = StringMap.find arg arities in
+        then let arity = TzString.Map.find arg arities in
           check_help_flag help_flag tl >>=? fun () ->
           match arity, tl with
-          | 0, tl -> make_args_dict arities (StringMap.add arg None dict, other_args) tl
+          | 0, tl -> make_args_dict arities (TzString.Map.add arg None dict, other_args) tl
-          | 1, value :: tl' -> make_args_dict arities (StringMap.add arg (Some value) dict, other_args) tl'
+          | 1, value :: tl' -> make_args_dict arities (TzString.Map.add arg (Some value) dict, other_args) tl'
           | 1, [] -> fail (Option_expected_argument arg)
           | _, _ ->
               raise (Failure "cli_entries: Arguments with arity not equal to 1 or 0 not suppored")
         else make_args_dict arities (dict, arg :: other_args) tl
   in make_args_dict
-    (make_arities_dict StringMap.empty spec)
+    (make_arities_dict TzString.Map.empty spec)
-    (StringMap.empty, [])
+    (TzString.Map.empty, [])
     args >>|? fun (dict, remaining) ->
   (dict, List.rev remaining)
 
@@ -269,7 +267,6 @@ let parse_initial_options :
 
 (* Some combinators for writing commands concisely. *)
 let param ~name ~desc kind next = Param (name, desc, kind, next)
-let seq ~name ~desc kind = Seq (name, desc, kind)
 let seq_of_param param =
   match param Stop with
   | Param (n, desc, parameter, Stop) -> Seq (n, desc, parameter)
@@ -475,12 +472,12 @@ let find_command tree initial_arguments =
       | TParam { stop = Some _ }), ("-help" | "--help") :: _ ->
         fail (Help_flag ( gather_commands tree))
     | TStop c, [] -> return (c, empty_args_dict, initial_arguments)
-    | TStop (Command { options=Argument { spec }} as c), args ->
+    | TStop (Command { options=Argument { spec } } as c), args ->
         if not (has_options c)
         then fail (Extra_arguments (List.rev acc, c))
         else make_args_dict (Help_flag [c]) spec args >>=? fun args_dict ->
           return (c, args_dict, initial_arguments)
-    | TSeq (Command { options=Argument { spec }} as c, _), remaining ->
+    | TSeq (Command { options=Argument { spec } } as c, _), remaining ->
         if List.exists (function "-help" | "--help" -> true | _ -> false) remaining then
           fail (Help_flag ( gather_commands tree))
         else
@@ -508,7 +505,7 @@ let find_command tree initial_arguments =
   in help tree initial_arguments []
 
 let trim s = (* config-file wokaround *)
-  Utils.split '\n' s |>
+  TzString.split '\n' s |>
   List.map String.trim |>
   String.concat "\n"
 
@@ -678,13 +675,6 @@ let print_group print_command ppf ({ title }, commands) =
     title
     (Format.pp_print_list print_command) commands
 
-let command_args_help ppf command =
-  Format.fprintf ppf
-    "%a"
-    (fun ppf (Command { params ; options=Argument { spec } }) ->
-       print_commandline ppf ([], spec, params))
-    command
-
 let usage
     ppf
     ?global_options
@@ -778,7 +768,7 @@ let rec remaining_spec :
         else parameter :: (remaining_spec seen rest)
 
 let complete_options (type ctx) continuation args args_spec ind (ctx : ctx) =
-  let arities = make_arities_dict StringMap.empty args_spec in
+  let arities = make_arities_dict TzString.Map.empty args_spec in
   let rec complete_spec : type a. string -> (a, ctx) args -> string list tzresult Lwt.t =
     fun name -> function
       | NoArgs -> return []
@@ -795,11 +785,11 @@ let complete_options (type ctx) continuation args args_spec ind (ctx : ctx) =
         Pervasives.failwith
           "cli_entries internal autocomplete error"
     | arg :: tl ->
-        if StringMap.mem arg arities
+        if TzString.Map.mem arg arities
         then
           let seen = StringSet.add arg seen in
           begin
-            match StringMap.find arg arities, tl with
+            match TzString.Map.find arg arities, tl with
             | 0, args when ind = 0 ->
                 continuation args 0 >>|? fun cont_args ->
                 remaining_spec seen args_spec @ cont_args
@@ -853,7 +843,7 @@ let autocomplete ~script ~cur_arg ~prev_arg ~args ~tree ~global_options cctxt =
     | [] -> None
     | hd :: tl ->
         if hd = prev_arg
-        then Some (Utils.unopt ~default:(n + 1) (ind (n + 1) tl))
+        then Some (Option.unopt ~default:(n + 1) (ind (n + 1) tl))
         else (ind (n + 1) tl) in
   begin
     if prev_arg = script

lib_stdlib_lwt/jbuild

@@ -0,0 +1,19 @@
+(jbuild_version 1)
+
+(library
+ ((name tezos_stdlib_lwt)
+  (public_name tezos-stdlib-lwt)
+  (flags (:standard -w -9-30
+                    -open Tezos_stdlib
+                    -open Tezos_data_encoding
+                    -open Tezos_error_monad))
+  (libraries (tezos-stdlib
+              tezos-data-encoding
+              tezos-error-monad
+              lwt.unix
+              ipaddr.unix))))
+
+(alias
+ ((name runtest_indent)
+  (deps ((glob_files *.ml) (glob_files *.mli)))
+  (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${<}))))

lib_stdlib_lwt/lwt_canceler.ml

@@ -0,0 +1,53 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Lwt.Infix
+
+type t = {
+  cancelation: unit Lwt_condition.t ;
+  cancelation_complete: unit Lwt_condition.t ;
+  mutable cancel_hook: unit -> unit Lwt.t ;
+  mutable canceling: bool ;
+  mutable canceled: bool ;
+}
+
+let create () =
+  let cancelation = Lwt_condition.create () in
+  let cancelation_complete = Lwt_condition.create () in
+  { cancelation ; cancelation_complete ;
+    cancel_hook = (fun () -> Lwt.return ()) ;
+    canceling = false ;
+    canceled = false ;
+  }
+
+let cancel st =
+  if st.canceled then
+    Lwt.return ()
+  else if st.canceling then
+    Lwt_condition.wait st.cancelation_complete
+  else begin
+    st.canceling <- true ;
+    Lwt_condition.broadcast st.cancelation () ;
+    Lwt.finalize
+      st.cancel_hook
+      (fun () ->
+         st.canceled <- true ;
+         Lwt_condition.broadcast st.cancelation_complete () ;
+         Lwt.return ())
+  end
+
+let on_cancel st cb =
+  let hook = st.cancel_hook in
+  st.cancel_hook <- (fun () -> hook () >>= cb)
+
+let cancelation st =
+  if st.canceling then Lwt.return ()
+  else Lwt_condition.wait st.cancelation
+
+let canceled st = st.canceling

lib_stdlib_lwt/lwt_canceler.mli

@@ -0,0 +1,15 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t
+val create : unit -> t
+val cancel : t -> unit Lwt.t
+val cancelation : t -> unit Lwt.t
+val on_cancel : t -> (unit -> unit Lwt.t) -> unit
+val canceled : t -> bool

lib_stdlib_lwt/lwt_idle_waiter.ml

@@ -0,0 +1,87 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Error_monad
+
+type t =
+  { mutable pending_tasks : unit Lwt.u list ;
+    mutable pending_idle : (unit -> unit Lwt.t) list ;
+    mutable running_tasks : int ;
+    mutable running_idle : bool ;
+    mutable prevent_tasks : bool }
+
+let create () =
+  { pending_tasks = [] ;
+    pending_idle = [] ;
+    running_tasks = 0 ;
+    running_idle = false ;
+    prevent_tasks = false }
+
+let rec may_run_idle_tasks w =
+  if w.running_tasks = 0 && not w.running_idle then
+    match w.pending_idle with
+    | [] -> ()
+    | pending_idle ->
+        w.running_idle <- true ;
+        w.prevent_tasks <- false ;
+        w.pending_idle <- [] ;
+        Lwt.async (fun () ->
+            let pending_idle = List.rev pending_idle in
+            Lwt_list.iter_s (fun f -> f ()) pending_idle >>= fun () ->
+            w.running_idle <- false ;
+            let pending_tasks = List.rev w.pending_tasks in
+            w.pending_tasks <- [] ;
+            List.iter (fun u -> Lwt.wakeup u ()) pending_tasks ;
+            may_run_idle_tasks w ;
+            Lwt.return ())
+
+let wrap_error f =
+  Lwt.catch
+    (fun () -> f () >>= fun r -> Lwt.return (Ok r))
+    (fun exn -> Lwt.return (Error exn))
+
+let unwrap_error = function
+  | Ok r -> Lwt.return r
+  | Error exn -> Lwt.fail exn
+
+let wakeup_error u = function
+  | Ok r -> Lwt.wakeup u r
+  | Error exn -> Lwt.wakeup_exn u exn
+
+let rec task w f =
+  if w.running_idle || w.prevent_tasks then
+    let t, u = Lwt.task () in
+    w.pending_tasks <- u :: w.pending_tasks ;
+    t >>= fun () -> task w f
+  else begin
+    w.running_tasks <- w.running_tasks + 1 ;
+    wrap_error f >>= fun res ->
+    w.running_tasks <- w.running_tasks - 1 ;
+    may_run_idle_tasks w ;
+    unwrap_error res
+  end
+
+let when_idle w f =
+  let t, u = Lwt.task () in
+  let canceled = ref false in
+  Lwt.on_cancel t (fun () -> canceled := true) ;
+  let f () =
+    if !canceled then
+      Lwt.return ()
+    else
+      wrap_error f >>= fun res ->
+      wakeup_error u res ;
+      Lwt.return () in
+  w.pending_idle <- f :: w.pending_idle ;
+  may_run_idle_tasks w ;
+  t
+
+let force_idle w f =
+  w.prevent_tasks <- true ;
+  when_idle w f

lib_stdlib_lwt/lwt_idle_waiter.mli

@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t
+(** A lightweight scheduler to run tasks concurrently as well as
+    special callbacks that must be run in mutual exclusion with the
+    tasks (and each other). *)
+
+val create : unit -> t
+(** Creates a new task / idle callback scheduler *)
+
+val task : t -> (unit -> 'a Lwt.t) -> 'a Lwt.t
+(** Schedule a task to be run as soon as no idle callbacks is
+    running, or as soon as the next idle callback has been run if it
+    was scheduled by {!force_idle}. *)
+
+val when_idle : t -> (unit -> 'a Lwt.t) -> 'a Lwt.t
+(** Runs a callback as soon as no task is running. Does not prevent
+    new tasks from being scheduled, the calling code should ensure
+    that some idle time will eventually come. Calling this function
+    from inside the callback will result in a dead lock. *)
+
+val force_idle : t -> (unit -> 'a Lwt.t) -> 'a Lwt.t
+(** Runs a callback as soon as possible. Lets all current tasks
+    finish, but postpones all new tasks until the end of the
+    callback. Calling this function from inside the callback will
+    result in a dead lock. *)

lib_stdlib_lwt/lwt_lock_file.ml

@@ -0,0 +1,58 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2017.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Error_monad
+
+let create_inner
+    lock_command
+    ?(close_on_exec=true)
+    ?(unlink_on_exit=false) fn =
+  protect begin fun () ->
+    Lwt_unix.openfile fn Unix.[O_CREAT ; O_WRONLY; O_TRUNC] 0o644 >>= fun fd ->
+    if close_on_exec then Lwt_unix.set_close_on_exec fd ;
+    Lwt_unix.lockf fd lock_command 0 >>= fun () ->
+    if unlink_on_exit then
+      Lwt_main.at_exit (fun () -> Lwt_unix.unlink fn) ;
+    let pid_str = string_of_int @@ Unix.getpid () in
+    Lwt_unix.write_string fd pid_str 0 (String.length pid_str) >>= fun _ ->
+    return ()
+  end
+
+let create = create_inner Unix.F_TLOCK
+
+let blocking_create
+    ?timeout
+    ?(close_on_exec=true)
+    ?(unlink_on_exit=false) fn =
+  let create () =
+    create_inner Unix.F_LOCK ~close_on_exec ~unlink_on_exit fn in
+  match timeout with
+  | None -> create ()
+  | Some duration -> Lwt_utils.with_timeout duration (fun _ -> create ())
+
+let is_locked fn =
+  if not @@ Sys.file_exists fn then return false else
+    protect begin fun () ->
+      Lwt_unix.openfile fn [Unix.O_RDONLY] 0o644 >>= fun fd ->
+      Lwt.finalize (fun () ->
+          Lwt.try_bind
+            (fun () -> Lwt_unix.(lockf fd F_TEST 0))
+            (fun () -> return false)
+            (fun _ -> return true))
+        (fun () -> Lwt_unix.close fd)
+    end
+
+let get_pid fn =
+  let open Lwt_io in
+  Lwt_utils.protect begin fun () ->
+    with_file ~mode:Input fn begin fun ic ->
+      read ic >>= fun content ->
+      return (int_of_string content)
+    end
+  end

lib_stdlib_lwt/lwt_lock_file.mli

@@ -9,15 +9,16 @@
 
 open Error_monad
 
-val mkdir: string -> unit
+val create :
+  ?close_on_exec:bool ->
+  ?unlink_on_exit:bool ->
+  string -> unit tzresult Lwt.t
 
-val check_dir: string -> unit tzresult Lwt.t
+val blocking_create :
-val is_directory: string -> bool
+  ?timeout:float ->
-
+  ?close_on_exec:bool ->
-val with_file_in: string -> (MBytes.t -> 'a Lwt.t) -> 'a Lwt.t
+  ?unlink_on_exit:bool ->
-val with_file_out: string -> MBytes.t -> unit Lwt.t
+  string -> unit tzresult Lwt.t
-
-val remove_file: ?cleanup:bool -> string -> unit Lwt.t
-
-val fold: string -> init:'a -> f:(string -> 'a -> 'a Lwt.t) -> 'a Lwt.t
 
+val is_locked : string -> bool tzresult Lwt.t
+val get_pid : string -> int tzresult Lwt.t

lib_stdlib_lwt/lwt_pipe.ml

@@ -67,8 +67,8 @@ let wait_pop q =
       q.pop_waiter <- Some (waiter, wakener) ;
       Lwt.protected waiter
 
-let length { queue } = Queue.length queue
+let length { queue ; _ } = Queue.length queue
-let is_empty { queue } = Queue.is_empty queue
+let is_empty { queue ; _ } = Queue.is_empty queue
 
 let rec empty q =
   if is_empty q
@@ -78,7 +78,7 @@ let rec empty q =
 exception Closed
 
 let rec push ({ closed ; queue ; current_size ;
-                max_size ; compute_size} as q) elt =
+                max_size ; compute_size ; _ } as q) elt =
   let elt_size = compute_size elt in
   if closed then
     Lwt.fail Closed
@@ -92,7 +92,7 @@ let rec push ({ closed ; queue ; current_size ;
     push q elt
 
 let push_now ({ closed ; queue ; compute_size ;
-                current_size ; max_size
+                current_size ; max_size ; _
               } as q) elt =
   if closed then raise Closed ;
   let elt_size = compute_size elt in
@@ -113,7 +113,7 @@ let safe_push_now q elt =
   try push_now_exn q elt
   with _ -> ()
 
-let rec pop ({ closed ; queue ; empty ; current_size } as q) =
+let rec pop ({ closed ; queue ; empty ; current_size ; _ } as q) =
   if not (Queue.is_empty queue) then
     let (elt_size, elt) = Queue.pop queue in
     notify_pop q ;
@@ -126,7 +126,7 @@ let rec pop ({ closed ; queue ; empty ; current_size } as q) =
     wait_push q >>= fun () ->
     pop q
 
-let rec peek ({ closed ; queue } as q) =
+let rec peek ({ closed ; queue ; _ } as q) =
   if not (Queue.is_empty queue) then
     let (_elt_size, elt) = Queue.peek queue in
     Lwt.return elt
@@ -138,7 +138,7 @@ let rec peek ({ closed ; queue } as q) =
 
 exception Empty
 
-let pop_now_exn ({ closed ; queue ; empty ; current_size } as q) =
+let pop_now_exn ({ closed ; queue ; empty ; current_size ; _ } as q) =
   if Queue.is_empty queue then
     (if closed then raise Closed else raise Empty) ;
   let (elt_size, elt) = Queue.pop queue in

lib_stdlib_lwt/lwt_utils.ml

@@ -58,132 +58,8 @@ let canceler ()
   in
   cancelation, cancel, on_cancel
 
-module Canceler = struct
-
-  type t = {
-    cancelation: unit Lwt_condition.t ;
-    cancelation_complete: unit Lwt_condition.t ;
-    mutable cancel_hook: unit -> unit Lwt.t ;
-    mutable canceling: bool ;
-    mutable canceled: bool ;
-  }
-
-  let create () =
-    let cancelation = LC.create () in
-    let cancelation_complete = LC.create () in
-    { cancelation ; cancelation_complete ;
-      cancel_hook = (fun () -> Lwt.return ()) ;
-      canceling = false ;
-      canceled = false ;
-    }
-
-  let cancel st =
-    if st.canceled then
-      Lwt.return ()
-    else if st.canceling then
-      LC.wait st.cancelation_complete
-    else begin
-      st.canceling <- true ;
-      LC.broadcast st.cancelation () ;
-      Lwt.finalize
-        st.cancel_hook
-        (fun () ->
-           st.canceled <- true ;
-           LC.broadcast st.cancelation_complete () ;
-           Lwt.return ())
-    end
-
-  let on_cancel st cb =
-    let hook = st.cancel_hook in
-    st.cancel_hook <- (fun () -> hook () >>= cb)
-
-  let cancelation st =
-    if st.canceling then Lwt.return ()
-    else LC.wait st.cancelation
-
-  let canceled st = st.canceling
-
-end
-
 module Idle_waiter = struct
 
-  type t =
-    { mutable pending_tasks : unit Lwt.u list ;
-      mutable pending_idle : (unit -> unit Lwt.t) list ;
-      mutable running_tasks : int ;
-      mutable running_idle : bool ;
-      mutable prevent_tasks : bool }
-
-  let create () =
-    { pending_tasks = [] ;
-      pending_idle = [] ;
-      running_tasks = 0 ;
-      running_idle = false ;
-      prevent_tasks = false }
-
-  let rec may_run_idle_tasks w =
-    if w.running_tasks = 0 && not w.running_idle then
-      match w.pending_idle with
-      | [] -> ()
-      | pending_idle ->
-          w.running_idle <- true ;
-          w.prevent_tasks <- false ;
-          w.pending_idle <- [] ;
-          Lwt.async (fun () ->
-              let pending_idle = List.rev pending_idle in
-              Lwt_list.iter_s (fun f -> f ()) pending_idle >>= fun () ->
-              w.running_idle <- false ;
-              let pending_tasks = List.rev w.pending_tasks in
-              w.pending_tasks <- [] ;
-              List.iter (fun u -> Lwt.wakeup u ()) pending_tasks ;
-              may_run_idle_tasks w ;
-              Lwt.return ())
-
-  let wrap_error f =
-    Lwt.catch
-      (fun () -> f () >>= fun r -> Lwt.return (Ok r))
-      (fun exn -> Lwt.return (Error exn))
-
-  let unwrap_error = function
-    | Ok r -> Lwt.return r
-    | Error exn -> Lwt.fail exn
-
-  let wakeup_error u = function
-    | Ok r -> Lwt.wakeup u r
-    | Error exn -> Lwt.wakeup_exn u exn
-
-  let rec task w f =
-    if w.running_idle || w.prevent_tasks then
-      let t, u = Lwt.task () in
-      w.pending_tasks <- u :: w.pending_tasks ;
-      t >>= fun () -> task w f
-    else begin
-      w.running_tasks <- w.running_tasks + 1 ;
-      wrap_error f >>= fun res ->
-      w.running_tasks <- w.running_tasks - 1 ;
-      may_run_idle_tasks w ;
-      unwrap_error res
-    end
-
-  let when_idle w f =
-    let t, u = Lwt.task () in
-    let canceled = ref false in
-    Lwt.on_cancel t (fun () -> canceled := true) ;
-    let f () =
-      if !canceled then
-        Lwt.return ()
-      else
-        wrap_error f >>= fun res ->
-        wakeup_error u res ;
-        Lwt.return () in
-    w.pending_idle <- f :: w.pending_idle ;
-    may_run_idle_tasks w ;
-    t
-
-  let force_idle w f =
-    w.prevent_tasks <- true ;
-    when_idle w f
-
 end
 
 type trigger =
@@ -433,7 +309,7 @@ let rec create_dir ?(perm = 0o755) dir =
       Lwt_unix.mkdir dir perm
   | true ->
       Lwt_unix.stat dir >>= function
-      | {st_kind = S_DIR} -> Lwt.return_unit
+      | { st_kind = S_DIR ; _ } -> Lwt.return_unit
       | _ -> failwith "Not a directory"
 
 let create_file ?(perm = 0o644) name content =
@@ -455,8 +331,8 @@ let protect ?on_error ?canceler t =
     match canceler with
     | None -> never_ending
     | Some canceler ->
-        ( Canceler.cancelation canceler >>= fun () ->
+        (Lwt_canceler.cancelation canceler >>= fun () ->
-          fail Canceled ) in
+         fail Canceled ) in
   let res =
     Lwt.pick [ cancelation ;
                Lwt.catch t (fun exn -> fail (Exn exn)) ] in
@@ -464,7 +340,7 @@ let protect ?on_error ?canceler t =
   | Ok _ -> res
   | Error err ->
       let canceled =
-        Utils.unopt_map canceler ~default:false ~f:Canceler.canceled in
+       Option.unopt_map canceler ~default:false ~f:Lwt_canceler.canceled in
       let err = if canceled then [Canceled] else err in
       match on_error with
       | None -> Lwt.return (Error err)
@@ -483,7 +359,7 @@ let () =
     (function Timeout -> Some () | _ -> None)
     (fun () -> Timeout)
 
-let with_timeout ?(canceler = Canceler.create ()) timeout f =
+let with_timeout ?(canceler = Lwt_canceler.create ()) timeout f =
   let timeout = Lwt_unix.sleep timeout in
   let target = f canceler in
   Lwt.choose [ timeout ; (target >|= fun _ -> ()) ] >>= fun () ->
@@ -492,63 +368,13 @@ let with_timeout ?(canceler = Canceler.create ()) timeout f =
     Lwt.cancel timeout ;
     target
   end else begin
-    Canceler.cancel canceler >>= fun () ->
+    Lwt_canceler.cancel canceler >>= fun () ->
     fail Timeout
   end
 
 let unless cond f =
   if cond then Lwt.return () else f ()
 
-module Lock_file = struct
-  let create_inner
-      lock_command
-      ?(close_on_exec=true)
-      ?(unlink_on_exit=false) fn =
-    protect begin fun () ->
-      Lwt_unix.openfile fn Unix.[O_CREAT ; O_WRONLY; O_TRUNC] 0o644 >>= fun fd ->
-      if close_on_exec then Lwt_unix.set_close_on_exec fd ;
-      Lwt_unix.lockf fd lock_command 0 >>= fun () ->
-      if unlink_on_exit then
-        Lwt_main.at_exit (fun () -> Lwt_unix.unlink fn) ;
-      let pid_str = string_of_int @@ Unix.getpid () in
-      Lwt_unix.write_string fd pid_str 0 (String.length pid_str) >>= fun _ ->
-      return ()
-    end
-
-  let create = create_inner Unix.F_TLOCK
-
-  let blocking_create
-      ?timeout
-      ?(close_on_exec=true)
-      ?(unlink_on_exit=false) fn =
-    let create () =
-      create_inner Unix.F_LOCK ~close_on_exec ~unlink_on_exit fn in
-    match timeout with
-    | None -> create ()
-    | Some duration -> with_timeout duration (fun _ -> create ())
-
-  let is_locked fn =
-    if not @@ Sys.file_exists fn then return false else
-      protect begin fun () ->
-        Lwt_unix.openfile fn [Unix.O_RDONLY] 0o644 >>= fun fd ->
-        Lwt.finalize (fun () ->
-            Lwt.try_bind
-              (fun () -> Lwt_unix.(lockf fd F_TEST 0))
-              (fun () -> return false)
-              (fun _ -> return true))
-          (fun () -> Lwt_unix.close fd)
-      end
-
-  let get_pid fn =
-    let open Lwt_io in
-    protect begin fun () ->
-      with_file ~mode:Input fn begin fun ic ->
-        read ic >>= fun content ->
-        return (int_of_string content)
-      end
-    end
-end
-
 let of_sockaddr = function
   | Unix.ADDR_UNIX _ -> None
   | Unix.ADDR_INET (addr, port) ->
@@ -562,7 +388,7 @@ let getaddrinfo ~passive ~node ~service =
     ( AI_SOCKTYPE SOCK_STREAM ::
       (if passive then [AI_PASSIVE] else []) ) >>= fun addr ->
   let points =
-    Utils.filter_map
+    TzList.filter_map
-      (fun { ai_addr } -> of_sockaddr ai_addr)
+      (fun { ai_addr ; _ } -> of_sockaddr ai_addr)
       addr in
   Lwt.return points

lib_stdlib_lwt/lwt_utils.mli

@@ -11,51 +11,11 @@ val may: f:('a -> unit Lwt.t) -> 'a option -> unit Lwt.t
 
 val never_ending: 'a Lwt.t
 
-val canceler : unit ->
+val canceler: unit ->
   (unit -> unit Lwt.t) *
   (unit -> unit Lwt.t) *
   ((unit -> unit Lwt.t) -> unit)
 
-module Canceler : sig
-
-  type t
-  val create : unit -> t
-  val cancel : t -> unit Lwt.t
-  val cancelation : t -> unit Lwt.t
-  val on_cancel : t -> (unit -> unit Lwt.t) -> unit
-  val canceled : t -> bool
-
-end
-
-module Idle_waiter : sig
-
-  type t
-  (** A lightweight scheduler to run tasks concurrently as well as
-      special callbacks that must be run in mutual exclusion with the
-      tasks (and each other). *)
-
-  val create : unit -> t
-  (** Creates a new task / idle callback scheduler *)
-
-  val task : t -> (unit -> 'a Lwt.t) -> 'a Lwt.t
-  (** Schedule a task to be run as soon as no idle callbacks is
-      running, or as soon as the next idle callback has been run if it
-      was scheduled by {!force_idle}. *)
-
-  val when_idle : t -> (unit -> 'a Lwt.t) -> 'a Lwt.t
-  (** Runs a callback as soon as no task is running. Does not prevent
-      new tasks from being scheduled, the calling code should ensure
-      that some idle time will eventually come. Calling this function
-      from inside the callback will result in a dead lock. *)
-
-  val force_idle : t -> (unit -> 'a Lwt.t) -> 'a Lwt.t
-  (** Runs a callback as soon as possible. Lets all current tasks
-      finish, but postpones all new tasks until the end of the
-      callback. Calling this function from inside the callback will
-      result in a dead lock. *)
-
-end
-
 val worker:
   string ->
   run:(unit -> unit Lwt.t) ->
@@ -88,32 +48,16 @@ open Error_monad
 type error += Canceled
 val protect :
   ?on_error:(error list -> 'a tzresult Lwt.t) ->
-  ?canceler:Canceler.t ->
+  ?canceler:Lwt_canceler.t ->
   (unit -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t
 
 type error += Timeout
 val with_timeout:
-  ?canceler:Canceler.t ->
+  ?canceler:Lwt_canceler.t ->
-  float -> (Canceler.t -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t
+  float -> (Lwt_canceler.t -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t
 
 val unless: bool -> (unit -> unit Lwt.t) -> unit Lwt.t
 
-module Lock_file : sig
-  val create :
-    ?close_on_exec:bool ->
-    ?unlink_on_exit:bool ->
-    string -> unit tzresult Lwt.t
-
-  val blocking_create :
-    ?timeout:float ->
-    ?close_on_exec:bool ->
-    ?unlink_on_exit:bool ->
-    string -> unit tzresult Lwt.t
-
-  val is_locked : string -> bool tzresult Lwt.t
-  val get_pid : string -> int tzresult Lwt.t
-end
-
 val getaddrinfo:
   passive:bool ->
   node:string -> service:string ->

lib_stdlib_lwt/tezos-stdlib-lwt.opam

@@ -0,0 +1,24 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "https://gitlab.com/tezos/tezos.git"
+license: "unreleased"
+depends: [
+  "ocamlfind" { build }
+  "jbuilder" { build & >= "1.0+beta15" }
+  "base-bigarray"
+  "tezos-stdlib"
+  "tezos-data-encoding"
+  "tezos-error-monad"
+  "lwt.unix"
+  "ipaddr.unix"
+]
+build: [
+  [ "jbuilder" "build" "-p" name "-j" jobs ]
+]
+build-test: [
+  [ "jbuilder" "runtest" "-p" name "-j" jobs ]
+]

scripts/jbuild

@@ -0,0 +1,2 @@
+(jbuild_version 1)
+

src/attacker/attacker_minimal.ml

@@ -11,7 +11,6 @@ open Format
 include Logging.Make(struct let name = "attacker" end)
 
 module Proto = Client_embedded_proto_alpha
-module Ed25519 = Proto.Local_environment.Environment.Ed25519
 
 (* the genesis block and network *)
 let genesis_block_hashed = Block_hash.of_b58check

src/client/client_aliases.ml

@@ -266,7 +266,7 @@ module Alias = functor (Entity : Entity) -> struct
              >>=? fun content ->
              of_source cctxt content in
            begin
-             match Utils.split ~limit:1 ':' s with
+             match String.split ~limit:1 ':' s with
              | [ "alias" ; alias ]->
                  find cctxt alias
              | [ "text" ; text ] ->

src/client/client_config.ml

@@ -76,11 +76,10 @@ module Cfg_file = struct
          (base_dir, Some node_addr, Some node_port,
           Some tls, Some web_port))
       (fun (base_dir, node_addr, node_port, tls, web_port) ->
-         let open Utils in
+         let node_addr = Option.unopt ~default:default.node_addr node_addr in
-         let node_addr = unopt ~default:default.node_addr node_addr in
+         let node_port = Option.unopt ~default:default.node_port node_port in
-         let node_port = unopt ~default:default.node_port node_port in
+         let tls = Option.unopt ~default:default.tls tls in
-         let tls = unopt ~default:default.tls tls in
+         let web_port = Option.unopt ~default:default.web_port web_port in
-         let web_port = unopt ~default:default.web_port web_port in
          { base_dir ; node_addr ; node_port ; tls ; web_port })
       (obj5
          (req "base_dir" string)
@@ -272,11 +271,11 @@ let parse_config_args (ctx : Client_commands.context) argv =
     Format.eprintf "Error: %s is not a directory.@." base_dir ;
     exit 1 ;
   end ;
-  IO.mkdir base_dir ;
+  Utils.mkdir base_dir ;
   if Sys.file_exists config_dir && not (Sys.is_directory config_dir) then begin
     Format.eprintf "Error: %s is not a directory.@." config_dir ;
     exit 1 ;
   end ;
-  IO.mkdir config_dir ;
+  Utils.mkdir config_dir ;
   if not (Sys.file_exists config_file) then Cfg_file.write config_file cfg ;
   (cfg, { block ; print_timings = timings ; log_requests ; force ; protocol }, remaining)

src/client/client_debug.ml

@@ -27,25 +27,25 @@ let pp_block ppf
      @ Operations hash: %a\
      @ Operations: @[<v>%a@]\
      @ Data (hex encoded): \"%s\"@]"
-    Hash.Block_hash.pp hash
+    Block_hash.pp hash
     Context.pp_test_network test_network
     level
     proto_level
-    Hash.Block_hash.pp predecessor
+    Block_hash.pp predecessor
-    Hash.Protocol_hash.pp protocol
+    Protocol_hash.pp protocol
-    Hash.Net_id.pp net_id
+    Net_id.pp net_id
     Time.pp_hum timestamp
     (Format.pp_print_list
        ~pp_sep:Format.pp_print_space
        Format.pp_print_string)
     (List.map Hex_encode.hex_of_bytes fitness)
-    Hash.Operation_list_list_hash.pp operations_hash
+    Operation_list_list_hash.pp operations_hash
     (fun ppf -> function
        | None -> Format.fprintf ppf "None"
        | Some operations ->
            Format.pp_print_list ~pp_sep:Format.pp_print_newline
              (Format.pp_print_list ~pp_sep:Format.pp_print_space
-                (fun ppf (oph, _) -> Hash.Operation_hash.pp ppf oph))
+                (fun ppf (oph, _) -> Operation_hash.pp ppf oph))
              ppf operations)
     operations
     (Hex_encode.hex_of_bytes data)
@@ -65,7 +65,7 @@ let stuck_node_report (cctxt : Client_commands.context) file =
   print_title "Registered protocols:" 2 >>=? fun () ->
   return @@ Format.pp_print_list
     ~pp_sep:Format.pp_print_newline
-    (fun ppf (protocol, _) -> Hash.Protocol_hash.pp ppf protocol)
+    (fun ppf (protocol, _) -> Protocol_hash.pp ppf protocol)
     ppf
     (Client_commands.get_versions ()) >>=? fun () ->
   skip_line () >>=? fun () ->

src/client/client_generic_rpcs.ml

@@ -171,8 +171,6 @@ let editor_fill_in schema =
 
 (*-- Nice list display ------------------------------------------------------*)
 
-module StringMap = Map.Make(String)
-
 let rec count =
   let open RPC.Description in
   function
@@ -184,14 +182,14 @@ let rec count =
         match subdirs with
         | None -> 0
         | Some (Suffixes subdirs) ->
-            StringMap.fold (fun _ t r -> r + count t) subdirs 0
+            RPC.StringMap.fold (fun _ t r -> r + count t) subdirs 0
         | Some (Arg (_, subdir)) -> count subdir in
       service + subdirs
 
 (*-- Commands ---------------------------------------------------------------*)
 
 let list url cctxt =
-  let args = Utils.split '/' url in
+  let args = String.split '/' url in
   Client_node_rpcs.describe cctxt.rpc_config
     ~recurse:true args >>=? fun tree ->
   let open RPC.Description in
@@ -202,7 +200,7 @@ let list url cctxt =
   let display_paragraph ppf description =
     Format.fprintf ppf "@,    @[%a@]"
       (fun ppf words -> List.iter (Format.fprintf ppf "%s@ ") words)
-      (Utils.split ' ' description)
+      (String.split ' ' description)
   in
   let display_arg ppf arg =
     match arg.RPC.Arg.descr with
@@ -236,7 +234,7 @@ let list url cctxt =
     | Static { services ; subdirs = None } ->
         display_services ppf (path, tpath, services)
     | Static { services ; subdirs = Some (Suffixes subdirs) } -> begin
-        match RPC.MethMap.cardinal services, StringMap.bindings subdirs with
+        match RPC.MethMap.cardinal services, RPC.StringMap.bindings subdirs with
         | 0, [] -> ()
         | 0, [ n, solo ] ->
             display ppf (path @ [ n ], tpath @ [ n ], solo)
@@ -290,7 +288,7 @@ let list url cctxt =
 
 
 let schema url cctxt =
-  let args = Utils.split '/' url in
+  let args = String.split '/' url in
   let open RPC.Description in
   Client_node_rpcs.describe cctxt.rpc_config ~recurse:false args >>=? function
   | Static { services } -> begin
@@ -315,7 +313,7 @@ let schema url cctxt =
       return ()
 
 let format url cctxt =
-  let args = Utils.split '/' url in
+  let args = String.split '/' url in
   let open RPC.Description in
   Client_node_rpcs.describe cctxt.rpc_config ~recurse:false args >>=? function
   | Static { services } -> begin
@@ -354,7 +352,7 @@ let fill_in schema =
   | _ -> editor_fill_in schema
 
 let call url cctxt =
-  let args = Utils.split '/' url in
+  let args = String.split '/' url in
   let open RPC.Description in
   Client_node_rpcs.describe cctxt.rpc_config ~recurse:false args >>=? function
   | Static { services } -> begin
@@ -381,7 +379,7 @@ let call url cctxt =
       return ()
 
 let call_with_json url json (cctxt: Client_commands.context) =
-  let args = Utils.split '/' url in
+  let args = String.split '/' url in
   match Data_encoding_ezjsonm.from_string json with
   | Error err ->
       cctxt.error