Merge branch 'master' into crypto-box

src/client/embedded/bootstrap/client_proto_rpcs.mli

@@ -29,7 +29,7 @@ module Constants : sig
   val first_free_mining_slot: block -> int32 tzresult Lwt.t
   val max_signing_slot: block -> int tzresult Lwt.t
   val instructions_per_transaction: block -> int tzresult Lwt.t
-  val stamp_threshold: block -> int tzresult Lwt.t
+  val stamp_threshold: block -> int64 tzresult Lwt.t
 end
 
 module Context : sig

src/node/updater/environment.ml

@@ -134,8 +134,16 @@ module Make(Param : sig val name: string end)() = struct
   module Compare = Compare
   module Array = Array
   module List = List
-  module Bytes = Bytes
-  module String = String
+  module Bytes = struct
+    include Bytes
+    include EndianBytes.BigEndian
+    module LE = EndianBytes.LittleEndian
+  end
+  module String = struct
+    include String
+    include EndianString.BigEndian
+    module LE = EndianString.LittleEndian
+  end
   module Set = Set
   module Map = Map
   module Int32 = Int32

src/proto/bootstrap/constants_repr.ml

@@ -39,7 +39,7 @@ type constants = {
   first_free_mining_slot: int32 ;
   max_signing_slot: int ;
   instructions_per_transaction: int ;
-  proof_of_work_threshold: int ;
+  proof_of_work_threshold: int64 ;
 }
 
 let default = {
@@ -56,7 +56,8 @@ let default = {
   first_free_mining_slot = 16l ;
   max_signing_slot = 15 ;
   instructions_per_transaction = 16 * 1024 ;
-  proof_of_work_threshold = 8 ;
+  proof_of_work_threshold =
+    Int64.(lognot (sub (shift_left 1L 56) 1L)) ;
 }
 
 let opt (=) def v = if def = v then None else Some v
@@ -95,7 +96,7 @@ let constants_encoding =
          opt Int.(=)
            default.instructions_per_transaction c.instructions_per_transaction
        and proof_of_work_threshold =
-         opt Int.(=)
+         opt Int64.(=)
            default.proof_of_work_threshold c.proof_of_work_threshold
        in
        ( cycle_length,
@@ -144,7 +145,7 @@ let constants_encoding =
         (opt "first_free_mining_slot" int32)
         (opt "max_signing_slot" int31)
         (opt "instructions_per_transaction" int31)
-        (opt "proof_of_work_threshold" int31)
+        (opt "proof_of_work_threshold" int64)
     )
 
 type error += Constant_read of exn

src/proto/bootstrap/mining.ml

@@ -132,16 +132,10 @@ let first_endorsement_slots
   endorsement_priorities ctxt level >>=? fun delegate_list ->
   select_delegate delegate delegate_list max_priority
 
-
 let check_hash hash stamp_threshold =
-  let bytes = Block_hash.to_bytes hash in
-  let len = MBytes.length bytes * 8 in
-  try
-    for i = len - 1 downto (len - stamp_threshold) do
-      if MBytes.get_bool bytes i then raise Exit
-    done;
-    true
-  with Exit -> false
+  let bytes = Block_hash.to_raw hash in
+  let word = String.get_int64 bytes 0 in
+  Compare.Uint64.(word < stamp_threshold)
 
 let check_header_hash {Block.shell;proto;signature} stamp_threshold =
   let hash =

src/proto/bootstrap/mining.mli

@@ -70,7 +70,7 @@ val first_endorsement_slots:
 val check_signature:
   context -> Block.header -> public_key_hash -> unit tzresult Lwt.t
 
-val check_hash: Block_hash.t -> int -> bool
+val check_hash: Block_hash.t -> int64 -> bool
 val check_proof_of_work_stamp:
   context -> Block.header -> unit tzresult Lwt.t
 

src/proto/bootstrap/script_int_repr.ml

@@ -141,23 +141,18 @@ let logsr _ (Int va) (Int vb) =
   Int (Int64.shift_right_logical va (Int64.to_int vb))
 
 (* sign aware comparison *)
-let signed_compare va vb =
-  Compare.Int64.(if va = vb then 0 else if va > vb then 1 else -1)
-let unsigned_compare va vb =
-  Compare.Int64.(if va >= 0L then if vb >= 0L then signed_compare va vb else -1
-                 else if vb >= 0L then 1 else signed_compare va vb)
 let compare
   : type s l. (s, l) int_kind -> (s, l) int_val -> (s, l) int_val -> (signed, sixtyfour) int_val
   = fun kind (Int va) (Int vb) ->
     let cmp = match kind with
-      | Int8 -> signed_compare va vb
-      | Uint8 -> unsigned_compare va vb
-      | Int16 -> signed_compare va vb
-      | Uint16 -> unsigned_compare va vb
-      | Int32 -> signed_compare va vb
-      | Uint32 -> unsigned_compare va vb
-      | Int64 -> signed_compare va vb
-      | Uint64 -> unsigned_compare va vb in
+      | Int8 -> Compare.Int64.compare va vb
+      | Uint8 -> Compare.Uint64.compare va vb
+      | Int16 -> Compare.Int64.compare va vb
+      | Uint16 -> Compare.Uint64.compare va vb
+      | Int32 -> Compare.Int64.compare va vb
+      | Uint32 -> Compare.Uint64.compare va vb
+      | Int64 -> Compare.Int64.compare va vb
+      | Uint64 -> Compare.Uint64.compare va vb in
     Int Compare.Int.(if cmp = 0 then 0L else if cmp > 0 then 1L else -1L)
 
 let equal kind va vb =
@@ -172,9 +167,9 @@ let checked_add : type s l. (s, l) int_kind -> (s, l) int_val -> (s, l) int_val
     | Uint16 -> checked_of_int64 Uint16 r
     | Int32 -> checked_of_int64 Int32 r
     | Uint32 -> checked_of_int64 Uint32 r
-    | Int64 when Compare.Int.(signed_compare r va < 0) -> None
+    | Int64 when Compare.Int.(Compare.Int64.compare r va < 0) -> None
     | Int64 -> Some (Int r)
-    | Uint64 when Compare.Int.(unsigned_compare r va < 0) -> None
+    | Uint64 when Compare.Int.(Compare.Uint64.compare r va < 0) -> None
     | Uint64 -> Some (Int r)
 
 let checked_sub : type s l. (s, l) int_kind -> (s, l) int_val -> (s, l) int_val -> (s, l) int_val option
@@ -186,10 +181,10 @@ let checked_sub : type s l. (s, l) int_kind -> (s, l) int_val -> (s, l) int_val
     | Int32 -> checked_of_int64 Int32 r
     | Uint32 -> checked_of_int64 Uint32 r
     | Int64 when Compare.Int64.(vb >= 0L) ->
-        if Compare.Int.(signed_compare r va <= 0) then Some (Int r) else None
+        if Compare.Int.(Compare.Int64.compare r va <= 0) then Some (Int r) else None
     | Int64 ->
-        if Compare.Int.(signed_compare r va >= 0) then Some (Int r) else None
-    | Uint64 when Compare.Int.(unsigned_compare r va > 0) -> None
+        if Compare.Int.(Compare.Int64.compare r va >= 0) then Some (Int r) else None
+    | Uint64 when Compare.Int.(Compare.Uint64.compare r va > 0) -> None
     | Uint64 -> Some (Int r)
 
 let checked_neg : type l. (signed, l) int_kind -> (signed, l) int_val -> (signed, l) int_val option

src/proto/bootstrap/services.ml

@@ -97,7 +97,7 @@ module Constants = struct
       ~description: "Stamp threshold"
       ~input: empty
       ~output: (wrap_tzerror @@
-                describe ~title: "proof_of_work threshold" int31)
+                describe ~title: "proof_of_work threshold" int64)
       RPC.Path.(custom_root / "constants" / "proof_of_work_threshold")
 
   let errors custom_root =

src/proto/bootstrap/services_registration.ml

@@ -79,7 +79,8 @@ let () =
 let proof_of_work_threshold ctxt =
   return @@ Constants.proof_of_work_threshold ctxt
 
-let () = register0 Services.Constants.proof_of_work_threshold proof_of_work_threshold
+let () =
+  register0 Services.Constants.proof_of_work_threshold proof_of_work_threshold
 
 let () =
   register1_noctxt Services.Constants.errors

src/proto/bootstrap/tezos_context.mli

@@ -184,7 +184,7 @@ module Constants : sig
   val first_free_mining_slot: context -> int32
   val max_signing_slot: context -> int
   val instructions_per_transaction: context -> int
-  val proof_of_work_threshold: context -> int
+  val proof_of_work_threshold: context -> int64
 
 end
 

src/proto/environment/bytes.mli

@@ -420,14 +420,79 @@ let s = Bytes.of_string "hello"
     [string] type for this purpose.
 *)
 
-(**/**)
+(** Functions reading and writing bytes  *)
 
-(* The following is for system use only. Do not call directly. *)
+val get_char: t -> int -> char
+(** [get_char buff i] reads 1 byte at offset i as a char *)
 
-external unsafe_get : bytes -> int -> char = "%string_unsafe_get"
-external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
-external unsafe_blit :
-  bytes -> int -> bytes -> int -> int -> unit
-  = "caml_blit_string" [@@noalloc]
-external unsafe_fill :
-  bytes -> int -> int -> char -> unit = "caml_fill_string" [@@noalloc]
+val get_uint8: t -> int -> int
+(** [get_uint8 buff i] reads 1 byte at offset i as an unsigned int of 8
+    bits. i.e. It returns a value between 0 and 2^8-1 *)
+
+val get_int8: t -> int -> int
+(** [get_int8 buff i] reads 1 byte at offset i as a signed int of 8
+    bits. i.e. It returns a value between -2^7 and 2^7-1 *)
+
+val set_char: t -> int -> char -> unit
+(** [set_char buff i v] writes [v] to [buff] at offset [i] *)
+
+val set_int8: t -> int -> int -> unit
+(** [set_int8 buff i v] writes the least significant 8 bits of [v]
+    to [buff] at offset [i] *)
+
+(** Functions reading according to Big Endian byte order *)
+
+val get_uint16: t -> int -> int
+(** [get_uint16 buff i] reads 2 bytes at offset i as an unsigned int
+      of 16 bits. i.e. It returns a value between 0 and 2^16-1 *)
+
+val get_int16: t -> int -> int
+(** [get_int16 buff i] reads 2 byte at offset i as a signed int of
+      16 bits. i.e. It returns a value between -2^15 and 2^15-1 *)
+
+val get_int32: t -> int -> int32
+(** [get_int32 buff i] reads 4 bytes at offset i as an int32. *)
+
+val get_int64: t -> int -> int64
+(** [get_int64 buff i] reads 8 bytes at offset i as an int64. *)
+
+val set_int16: t -> int -> int -> unit
+(** [set_int16 buff i v] writes the least significant 16 bits of [v]
+      to [buff] at offset [i] *)
+
+val set_int32: t -> int -> int32 -> unit
+(** [set_int32 buff i v] writes [v] to [buff] at offset [i] *)
+
+val set_int64: t -> int -> int64 -> unit
+(** [set_int64 buff i v] writes [v] to [buff] at offset [i] *)
+
+
+module LE: sig
+
+  (** Functions reading according to Little Endian byte order *)
+
+  val get_uint16: t -> int -> int
+  (** [get_uint16 buff i] reads 2 bytes at offset i as an unsigned int
+      of 16 bits. i.e. It returns a value between 0 and 2^16-1 *)
+
+  val get_int16: t -> int -> int
+  (** [get_int16 buff i] reads 2 byte at offset i as a signed int of
+      16 bits. i.e. It returns a value between -2^15 and 2^15-1 *)
+
+  val get_int32: t -> int -> int32
+  (** [get_int32 buff i] reads 4 bytes at offset i as an int32. *)
+
+  val get_int64: t -> int -> int64
+  (** [get_int64 buff i] reads 8 bytes at offset i as an int64. *)
+
+  val set_int16: t -> int -> int -> unit
+  (** [set_int16 buff i v] writes the least significant 16 bits of [v]
+      to [buff] at offset [i] *)
+
+  val set_int32: t -> int -> int32 -> unit
+  (** [set_int32 buff i v] writes [v] to [buff] at offset [i] *)
+
+  val set_int64: t -> int -> int64 -> unit
+  (** [set_int64 buff i v] writes [v] to [buff] at offset [i] *)
+
+end

src/proto/environment/compare.mli

@@ -16,7 +16,9 @@ module Char : S with type t = char
 module Bool : S with type t = bool
 module Int : S with type t = int
 module Int32 : S with type t = int32
+module Uint32 : S with type t = int32
 module Int64 : S with type t = int64
+module Uint64 : S with type t = int64
 module Float : S with type t = float
 module String : S with type t = string
 module List(P : S) : S with type t = P.t list

src/proto/environment/mBytes.mli

@@ -41,9 +41,6 @@ val substring: t -> int -> int -> string
 val get_char: t -> int -> char
 (** [get_char buff i] reads 1 byte at offset i as a char *)
 
-val get_bool: t -> int -> bool
-(** [get_bool buff i] reads 1 bit at offset i as an unsigned int bit. *)
-
 val get_uint8: t -> int -> int
 (** [get_uint8 buff i] reads 1 byte at offset i as an unsigned int of 8
     bits. i.e. It returns a value between 0 and 2^8-1 *)

src/proto/environment/string.mli

@@ -238,3 +238,53 @@ val compare: t -> t -> int
     {!Pervasives.compare}.  Along with the type [t], this function [compare]
     allows the module [String] to be passed as argument to the functors
     {!Set.Make} and {!Map.Make}. *)
+
+
+(** Functions reading bytes  *)
+
+val get_char: t -> int -> char
+(** [get_char buff i] reads 1 byte at offset i as a char *)
+
+val get_uint8: t -> int -> int
+(** [get_uint8 buff i] reads 1 byte at offset i as an unsigned int of 8
+    bits. i.e. It returns a value between 0 and 2^8-1 *)
+
+val get_int8: t -> int -> int
+(** [get_int8 buff i] reads 1 byte at offset i as a signed int of 8
+    bits. i.e. It returns a value between -2^7 and 2^7-1 *)
+
+(** Functions reading according to Big Endian byte order *)
+
+val get_uint16: t -> int -> int
+(** [get_uint16 buff i] reads 2 bytes at offset i as an unsigned int
+      of 16 bits. i.e. It returns a value between 0 and 2^16-1 *)
+
+val get_int16: t -> int -> int
+(** [get_int16 buff i] reads 2 byte at offset i as a signed int of
+      16 bits. i.e. It returns a value between -2^15 and 2^15-1 *)
+
+val get_int32: t -> int -> int32
+(** [get_int32 buff i] reads 4 bytes at offset i as an int32. *)
+
+val get_int64: t -> int -> int64
+(** [get_int64 buff i] reads 8 bytes at offset i as an int64. *)
+
+module LE: sig
+
+  (** Functions reading according to Little Endian byte order *)
+
+  val get_uint16: t -> int -> int
+  (** [get_uint16 buff i] reads 2 bytes at offset i as an unsigned int
+      of 16 bits. i.e. It returns a value between 0 and 2^16-1 *)
+
+  val get_int16: t -> int -> int
+  (** [get_int16 buff i] reads 2 byte at offset i as a signed int of
+      16 bits. i.e. It returns a value between -2^15 and 2^15-1 *)
+
+  val get_int32: t -> int -> int32
+  (** [get_int32 buff i] reads 4 bytes at offset i as an int32. *)
+
+  val get_int64: t -> int -> int64
+  (** [get_int64 buff i] reads 8 bytes at offset i as an int64. *)
+
+end

src/tezos-deps.opam

@@ -8,9 +8,9 @@ authors: [
   "Pierre Chambart <pierre@ocamlpro.com>"
   "Grégoire Henry <gregoire@ocamlpro.com>"
 ]
-dev-repo: "https://gitlab.ocamlpro.com/tezos/tezos.git"
-homepage: "https://gitlab.ocamlpro.com/tezos/tezos"
-bug-reports: "https://gitlab.ocamlpro.com/tezos/tezos/issues"
+dev-repo: "https://github.com/tezos/tezos.git"
+homepage: "https://gihub.com/tezos/tezos"
+bug-reports: "https://github.com/tezos/tezos/issues"
 depends: [
   "ocamlfind" {build}
   "base-bigarray"
@@ -21,7 +21,8 @@ depends: [
   "cryptokit"
   "git"
   "git-unix"
-  "irmin" {>= "0.11"}
+  "irmin-watcher" (* for `irmin.unix` *)
+  "irmin" {>= "0.12"}
   "menhir"
   "ocp-ocamlres" {>= "dev"}
   "ocplib-endian"

src/utils/base48.ml

@@ -89,6 +89,7 @@ let sha256 s =
   let computed_hash = hash#result in hash#wipe;
   computed_hash
 
+(* Prepend a 4 byte cryptographic checksum before encoding string s *)
 let safe_encode ?alphabet s =
   raw_encode ?alphabet (s ^ String.sub (sha256 (sha256 s)) 0 4)
 

src/utils/compare.ml

@@ -85,6 +85,32 @@ module Int64 = struct
   let min x y = if x <= y then x else y
 end
 
+module MakeUnsigned(Int : S)(Z : sig val zero : Int.t end) = struct
+  type t = Int.t
+  let compare va vb =
+    Int.(if va >= Z.zero then if vb >= Z.zero then compare va vb else -1
+           else if vb >= Z.zero then 1 else compare va vb)
+  let (=) = ((=) : t -> t -> bool)
+  let (<>) = ((<>) : t -> t -> bool)
+  let (<) a b =
+    Int.(if Z.zero <= a then
+             (a < b || b < Z.zero)
+           else
+             (b < Z.zero && a < b))
+  let (<=) a b =
+    Int.(if Z.zero <= a then
+             (a <= b || b < Z.zero)
+           else
+             (b < Z.zero && a <= b))
+  let (>=) a b = (<=) b a
+  let (>) a b = (<) b a
+  let max x y = if x >= y then x else y
+  let min x y = if x <= y then x else y
+end
+
+module Uint32 = MakeUnsigned(Int32)(struct let zero = 0l end)
+module Uint64 = MakeUnsigned(Int64)(struct let zero = 0L end)
+
 module Float = struct
   type t = float
   let (=) = ((=) : t -> t -> bool)

src/utils/compare.mli

@@ -24,7 +24,9 @@ module Char : S with type t = char
 module Bool : S with type t = bool
 module Int : S with type t = int
 module Int32 : S with type t = int32
+module Uint32 : S with type t = int32
 module Int64 : S with type t = int64
+module Uint64 : S with type t = int64
 module Float : S with type t = float
 module String : S with type t = string
 module List(P : S) : S with type t = P.t list

src/utils/mBytes.ml

@@ -73,9 +73,6 @@ let substring src srcoff len =
 
 include EndianBigstring.BigEndian
 
-let get_bool s off =
-  ((get_uint8 s (off / 8)) lsr (off mod 8)) land 1 = 1
-
 let of_float f =
   let buf = create 8 in
   set_float buf 0 f;

src/utils/mBytes.mli

@@ -49,9 +49,6 @@ val substring: t -> int -> int -> string
 val get_char: t -> int -> char
 (** [get_char buff i] reads 1 byte at offset i as a char *)
 
-val get_bool: t -> int -> bool
-(** [get_bool buff i] reads 1 bit at offset i as an unsigned int bit. *)
-
 val get_uint8: t -> int -> int
 (** [get_uint8 buff i] reads 1 byte at offset i as an unsigned int of 8
     bits. i.e. It returns a value between 0 and 2^8-1 *)