Merge branch 'crypto-box' into 'master'

Crypto box

Requesting code review for proof-of-work code

See merge request !115

src/.merlin

@@ -23,7 +23,6 @@ PKG cohttp
 PKG compiler-libs.optcomp
 PKG conduit
 PKG config-file
-PKG cryptokit
 PKG cstruct
 PKG dynlink
 PKG ezjsonm

src/Makefile

@@ -121,9 +121,9 @@ UTILS_LIB_IMPLS := \
   utils/cli_entries.ml \
   utils/compare.ml \
   utils/data_encoding.ml \
-  utils/crypto_box.ml \
   utils/time.ml \
   utils/hash.ml \
+  utils/crypto_box.ml \
   utils/error_monad_sig.ml \
   utils/error_monad.ml \
   utils/logging.ml \
@@ -133,7 +133,6 @@ UTILS_LIB_IMPLS := \
 UTILS_PACKAGES := \
   base64 \
   calendar \
-  cryptokit \
   cstruct \
   ezjsonm \
   lwt  \

src/client/embedded/bootstrap/client_proto_main.ml

@@ -9,7 +9,7 @@
 
 let protocol =
   Protocol_hash.of_b48check
-    "4prgmSgbaeMKbgLtLjpsHaDD9QvG2dbC2bLq2XBmyxd2RJgLFpcAg"
+    "4p64VagsbXchSF88eaPy5XrkqMLEjBCaSnaGv2vQkhv8e37Nnqmrd"
 
 let () =
   Client_version.register protocol @@

src/client/embedded/demo/client_proto_main.ml

@@ -9,7 +9,7 @@
 
 let protocol =
   Protocol_hash.of_b48check
-    "2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK"
+    "2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
 
 let demo () =
   let block = Client_config.block () in

src/node/net/p2p.ml

@@ -135,7 +135,8 @@ module Make (P: PARAMS) = struct
         port : int option ;
         versions : version list ;
         public_key : Crypto_box.public_key ;
-        nonce : Crypto_box.nonce ;
+        proof_of_work : Crypto_box.nonce ;
+        message_nonce : Crypto_box.nonce ;
       }
     | Disconnect
     | Bootstrap
@@ -146,20 +147,21 @@ module Make (P: PARAMS) = struct
     let open Data_encoding in
     union ~tag_size:`Uint16
       ([ case ~tag:0x00
-           (obj5
+           (obj6
               (req "gid" (Fixed.string gid_length))
               (req "port" uint16)
               (req "pubKey" Crypto_box.public_key_encoding)
-              (req "nonce" Crypto_box.nonce_encoding)
+              (req "proof_of_work" Crypto_box.nonce_encoding)
+              (req "message_nonce" Crypto_box.nonce_encoding)
               (req "versions" (Variable.list version_encoding)))
            (function
-             | Connect { gid ; port ; versions ; public_key ; nonce } ->
+             | Connect { gid ; port ; versions ; public_key ; proof_of_work; message_nonce } ->
                  let port = match port with None -> 0 | Some port -> port in
-                 Some (gid, port, public_key, nonce, versions)
+                 Some (gid, port, public_key, proof_of_work, message_nonce, versions)
              | _ -> None)
-           (fun (gid, port, public_key, nonce, versions) ->
+           (fun (gid, port, public_key, proof_of_work, message_nonce, versions) ->
               let port = if port = 0 then None else Some port in
-              Connect { gid ; port ; versions ; public_key ; nonce });
+              Connect { gid ; port ; versions ; public_key ; proof_of_work; message_nonce });
          case ~tag:0x01 null
            (function Disconnect -> Some () | _ -> None)
            (fun () -> Disconnect);
@@ -384,7 +386,7 @@ module Make (P: PARAMS) = struct
      (including the one sent when the connection is alive). Returns a
      canceler. *)
   let connect_to_peer
-      config limits my_gid my_public_key my_secret_key
+      config limits my_gid my_public_key my_secret_key my_proof_of_work
       socket (addr, port) push white_listed =
     (* a non exception-based cancelation mechanism *)
     let cancelation, cancel, on_cancel = canceler () in
@@ -400,14 +402,24 @@ module Make (P: PARAMS) = struct
       send_msg socket buf
         (Connect { gid = my_gid ;
                    public_key = my_public_key ;
-                   nonce = local_nonce ;
+                   proof_of_work = my_proof_of_work ;
+                   message_nonce = local_nonce ;
                    port = config.incoming_port ;
                    versions = P.supported_versions }) >>= fun _ ->
       pick [ (LU.sleep limits.peer_answer_timeout >>= fun () -> return Disconnect) ;
              recv_msg socket buf ] >>= function
-      | Connect { gid; port = listening_port; versions ; public_key ; nonce } ->
+      | Connect { gid; port = listening_port; versions ; public_key ; proof_of_work ; message_nonce } ->
           debug "(%a) connection requested from %a @@ %a:%d"
             pp_gid my_gid pp_gid gid Ipaddr.pp_hum addr port ;
+          let work_proved =
+            Crypto_box.check_proof_of_work
+              public_key proof_of_work Crypto_box.default_target in
+          if not work_proved then
+            begin
+            debug "connection rejected (invalid proof of work)";
+            cancel ()
+            end
+          else
             begin match common_version P.supported_versions versions with
             | None ->
                 debug "(%a) connection rejected (incompatible versions) from %a:%d"
@@ -417,7 +429,7 @@ module Make (P: PARAMS) = struct
                 if config.closed_network then
                   match listening_port with
                   | Some port when white_listed (addr, port) ->
-                      connected buf local_nonce version gid public_key nonce listening_port
+                      connected buf local_nonce version gid public_key message_nonce listening_port
                   | Some port ->
                       debug "(%a) connection rejected (out of the closed network) from %a:%d"
                         pp_gid my_gid Ipaddr.pp_hum addr port ;
@@ -427,7 +439,7 @@ module Make (P: PARAMS) = struct
                         pp_gid my_gid Ipaddr.pp_hum addr ;
                       cancel ()
                 else
-                  connected buf local_nonce version gid public_key nonce listening_port
+                  connected buf local_nonce version gid public_key message_nonce listening_port
             end
       | Advertise peers ->
           (* alternatively, one can refuse a connection but reply with
@@ -526,10 +538,11 @@ module Make (P: PARAMS) = struct
 
   let peers_file_encoding =
     let open Data_encoding in
-    obj4
+    obj5
       (req "gid" string)
       (req "public_key" Crypto_box.public_key_encoding)
       (req "secret_key" Crypto_box.secret_key_encoding)
+      (req "proof_of_work" Crypto_box.nonce_encoding)
       (req "peers"
          (obj3
             (req "known"
@@ -699,12 +712,14 @@ module Make (P: PARAMS) = struct
     on_cancel (fun () -> close_msg_queue () ; return ()) ;
     (* fill the known peers pools from last time *)
     Data_encoding.Json.read_file config.peers_file >>= fun res ->
-    let known_peers, black_list, my_gid, my_public_key, my_secret_key =
+    let known_peers, black_list, my_gid, my_public_key, my_secret_key, my_proof_of_work =
       let init_peers () =
         let my_gid =
           fresh_gid () in
         let (my_secret_key, my_public_key) =
           Crypto_box.random_keypair () in
+        let my_proof_of_work =
+          Crypto_box.generate_proof_of_work my_public_key Crypto_box.default_target in
         let known_peers =
           let source = { unreachable_since = None ;
                          connections = None ;
@@ -717,23 +732,23 @@ module Make (P: PARAMS) = struct
             PeerMap.empty config.known_peers in
         let black_list =
           BlackList.empty in
-        known_peers, black_list, my_gid, my_public_key, my_secret_key in
+        known_peers, black_list, my_gid, my_public_key, my_secret_key, my_proof_of_work in
       match res with
       | None ->
           let known_peers, black_list, my_gid,
-              my_public_key, my_secret_key = init_peers () in
+              my_public_key, my_secret_key, my_proof_of_work = init_peers () in
           debug "(%a) peer cache initiated" pp_gid my_gid ;
           ref known_peers, ref black_list, my_gid,
-          my_public_key, my_secret_key
+          my_public_key, my_secret_key, my_proof_of_work
       | Some json ->
           match Data_encoding.Json.destruct peers_file_encoding json with
           | exception _ ->
               let known_peers, black_list, my_gid,
-                  my_public_key, my_secret_key = init_peers () in
+                  my_public_key, my_secret_key, my_proof_of_work = init_peers () in
               debug "(%a) peer cache reset" pp_gid my_gid ;
               ref known_peers, ref black_list,
-              my_gid, my_public_key, my_secret_key
+              my_gid, my_public_key, my_secret_key, my_proof_of_work
-          | (my_gid, my_public_key, my_secret_key, (k, b, w)) ->
+          | (my_gid, my_public_key, my_secret_key, my_proof_of_work, (k, b, w)) ->
               let white_list =
                 List.fold_right PointSet.add w PointSet.empty in
               let known_peers =
@@ -761,7 +776,7 @@ module Make (P: PARAMS) = struct
                   BlackList.empty b in
               debug "(%a) peer cache loaded" pp_gid my_gid ;
               ref known_peers, ref black_list,
-              my_gid, my_public_key, my_secret_key
+              my_gid, my_public_key, my_secret_key, my_proof_of_work
     in
     (* some peer reachability predicates *)
     let black_listed (addr, _) =
@@ -781,6 +796,7 @@ module Make (P: PARAMS) = struct
           (my_gid,
            my_public_key,
            my_secret_key,
+           my_proof_of_work,
            PeerMap.fold
              (fun (addr, port) gid source (k, b, w) ->
                 let infos = match gid, source.connections with
@@ -1047,7 +1063,7 @@ module Make (P: PARAMS) = struct
           else
             let canceler =
               connect_to_peer
-                config limits my_gid my_public_key my_secret_key
+                config limits my_gid my_public_key my_secret_key my_proof_of_work
                 socket (addr, port) enqueue_event white_listed in
             debug "(%a) incoming peer @@ %a:%d"
               pp_gid my_gid Ipaddr.pp_hum addr port ;
@@ -1272,4 +1288,3 @@ module Make (P: PARAMS) = struct
   let get_metadata net gid = net.get_metadata gid
   let set_metadata net gid meta = net.set_metadata gid meta
 end
-

src/node/shell/node.ml

@@ -330,7 +330,7 @@ module RPC = struct
 
   let prevalidation_hash =
     Block_hash.of_b48check
-      "eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
+      "eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
 
   let get_net node = function
     | `Head _ | `Prevalidation -> node.global_validator, node.global_net

src/node/updater/environment.ml

@@ -25,10 +25,11 @@ module Ed25519 = struct
   let append_signature key msg =
     MBytes.concat msg (sign key msg)
 
-  module Public_key_hash = Hash.Make_SHA256(Base48)(struct
+  module Public_key_hash = Hash.Make_Blake2B(Base48)(struct
       let name = "Ed25519.Public_key_hash"
       let title = "An Ed25519 public key ID"
       let b48check_prefix = Base48.Prefix.ed25519_public_key_hash
+      let size = Some 20
     end)
 
   let hash v =

src/node_main.ml

@@ -12,18 +12,18 @@ open Logging.Node.Main
 
 let genesis_block =
   Block_hash.of_b48check
-    "eeHfgnr9QeDNvcMgSfATNeDeec4KG4CkHHkNNJt5B9xdVmsxhsHNR"
+    "grHGHkVfgJb5gPaRd5AtQsa65g9GyLcXgQsHbSnQ5SD5DEp2ctqck"
 
 let genesis_protocol =
   Protocol_hash.of_b48check
-    "4prgmSgbaeMKbgLtLjpsHaDD9QvG2dbC2bLq2XBmyxd2RJgLFpcAg"
+    "4p64VagsbXchSF88eaPy5XrkqMLEjBCaSnaGv2vQkhv8e37Nnqmrd"
 
 let test_protocol =
   Some (Protocol_hash.of_b48check
-          "2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK")
+          "2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3")
 
 let genesis_time =
-  Time.of_notation_exn "2016-08-01T00:00:00Z"
+  Time.of_notation_exn "2016-11-01T00:00:00Z"
 
 let genesis = {
   Store.time = genesis_time ;

src/proto/bootstrap/TEZOS_PROTOCOL

@@ -1,5 +1,5 @@
 {
-    "hash": "4prgmSgbaeMKbgLtLjpsHaDD9QvG2dbC2bLq2XBmyxd2RJgLFpcAg",
+    "hash": "4p64VagsbXchSF88eaPy5XrkqMLEjBCaSnaGv2vQkhv8e37Nnqmrd",
     "modules": [
 
         "Misc",

src/proto/bootstrap/mining.ml

@@ -133,7 +133,7 @@ let first_endorsement_slots
   select_delegate delegate delegate_list max_priority
 
 let check_hash hash stamp_threshold =
-  let bytes = Block_hash.to_raw hash in
+  let bytes = Block_hash.to_string hash in
   let word = String.get_int64 bytes 0 in
   Compare.Uint64.(word < stamp_threshold)
 

src/proto/bootstrap/storage_functors.ml

@@ -202,9 +202,10 @@ end
 module Make_data_set_storage (P : Single_data_description) = struct
 
   module Key = struct
-    include Hash.Make_minimal_SHA256(struct
+    include Hash.Make_minimal_Blake2B(struct
         let name = P.name
         let title = ("A " ^ P.name ^ "key")
+        let size = None
       end)
     let prefix = P.key
     let length = path_len

src/proto/bootstrap/tezos_hash.ml

@@ -18,34 +18,38 @@ module Prefix = struct
   let random_state_hash = make 15 (* never used... *)
 end
 
-module State_hash = Hash.Make_SHA256(Base48)(struct
+module State_hash = Hash.Make_Blake2B(Base48)(struct
     let name = "random"
     let title = "A random generation state"
     let b48check_prefix = Prefix.random_state_hash
+    let size = None
   end)
 module State_hash_set = Hash_set(State_hash)
 module State_hash_map = Hash_map(State_hash)
 
-module Nonce_hash = Hash.Make_SHA256(Base48)(struct
+module Nonce_hash = Hash.Make_Blake2B(Base48)(struct
     let name = "cycle_nonce"
     let title = "A nonce hash"
     let b48check_prefix = Prefix.nonce_hash
+    let size = None
   end)
 module Nonce_hash_set = Hash_set(Nonce_hash)
 module Nonce_hash_map = Hash_map(Nonce_hash)
 
-module Script_expr_hash = Hash.Make_SHA256(Base48)(struct
+module Script_expr_hash = Hash.Make_Blake2B(Base48)(struct
     let name = "script_expr"
     let title = "A script expression ID"
     let b48check_prefix = Prefix.script_expr_hash
+    let size = None
   end)
 module Script_expr_hash_set = Hash_set(Script_expr_hash)
 module Script_expr_hash_map = Hash_map(Script_expr_hash)
 
-module Contract_hash = Hash.Make_SHA256(Base48)(struct
+module Contract_hash = Hash.Make_Blake2B(Base48)(struct
     let name = "Contract_hash"
     let title = "A contract ID"
     let b48check_prefix = Prefix.contract_hash
+    let size = Some 20
   end)
 module Contract_hash_set = Hash_set(Contract_hash)
 module Contract_hash_map = Hash_map(Contract_hash)

src/proto/demo/TEZOS_PROTOCOL

@@ -1,4 +1,4 @@
 {
-    "hash": "2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK",
+    "hash": "2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3",
     "modules": ["Error", "Services", "Main"]
 }

src/proto/environment/hash.mli

@@ -21,10 +21,10 @@ module type MINIMAL_HASH = sig
   val size: int (* in bytes *)
   val compare: t -> t -> int
   val equal: t -> t -> bool
-  val of_raw: string -> t
-  val to_raw: t -> string
   val of_hex: string -> t
   val to_hex: t -> string
+  val of_string: string -> t
+  val to_string: t -> string
   val to_bytes: t -> MBytes.t
   val of_bytes: MBytes.t -> t
   val read: MBytes.t -> int -> t
@@ -54,12 +54,13 @@ end
 (** {2 Building Hashes} *******************************************************)
 
 (** The parameters for creating a new Hash type using
-    {!Make_SHA256}. Both {!name} and {!title} are only informative,
+    {!Make_Blake2B}. Both {!name} and {!title} are only informative,
     used in error messages and serializers. *)
 
 module type Name = sig
   val name : string
   val title : string
+  val size : int option
 end
 
 module type PrefixedName = sig
@@ -69,8 +70,8 @@ end
 
 (** Builds a new Hash type using Sha256. *)
 
-module Make_minimal_SHA256 (Name : Name) : MINIMAL_HASH
+module Make_minimal_Blake2B (Name : Name) : MINIMAL_HASH
-module Make_SHA256
+module Make_Blake2B
     (Register : sig
        val register_encoding:
          prefix: string ->
@@ -109,4 +110,3 @@ module Operation_hash_map : module type of Hash_map (Operation_hash)
 module Protocol_hash : HASH
 module Protocol_hash_set : Set.S with type elt = Protocol_hash.t
 module Protocol_hash_map : module type of Hash_map (Protocol_hash)
-

src/tezos-deps.opam

@@ -18,7 +18,6 @@ depends: [
   "calendar"
   "cohttp" {>= "0.21" }
   "config-file"
-  "cryptokit"
   "git"
   "git-unix"
   "irmin-watcher" (* for `irmin.unix` *)

src/utils/base48.ml

@@ -83,22 +83,25 @@ let raw_decode ?alphabet s =
   String.sub res 0 (String.length res - res_tzeros) ^
   String.make zeros '\000'
 
-let sha256 s =
+let checksum s =
-  let hash = Cryptokit.Hash.sha256 () in
+  let bytes = Bytes.of_string s in
-  hash#add_string s;
+  let hash =
-  let computed_hash = hash#result in hash#wipe;
+    let open Sodium.Generichash in
-  computed_hash
+    let state = init ~size:32 () in
+    Bytes.update state bytes ;
+    Bytes.of_hash (final state) in
+  Bytes.sub_string hash 0 4
 
-(* Prepend a 4 byte cryptographic checksum before encoding string s *)
+(* Prepend a 4 bytes cryptographic checksum before encoding string s *)
 let safe_encode ?alphabet s =
-  raw_encode ?alphabet (s ^ String.sub (sha256 (sha256 s)) 0 4)
+  raw_encode ?alphabet (s ^ checksum s)
 
 let safe_decode ?alphabet s =
   let s = raw_decode ?alphabet s in
   let len = String.length s in
   let msg = String.sub s 0 (len-4)
   and msg_hash = String.sub s (len-4) 4 in
-  if msg_hash <> String.sub (sha256 (sha256 msg)) 0 4 then
+  if msg_hash <> checksum msg then
     invalid_arg "safe_decode" ;
   msg
 

src/utils/crypto_box.ml

@@ -15,6 +15,8 @@ type secret_key = Sodium.Box.secret_key
 type public_key = Sodium.Box.public_key
 type channel_key = Sodium.Box.channel_key
 type nonce = Sodium.Box.nonce
+type target = int64 list (* used as unsigned intergers... *)
+exception TargetNot256Bit
 
 let random_keypair = Sodium.Box.random_keypair
 let random_nonce = Sodium.Box.random_nonce
@@ -24,6 +26,39 @@ let box_open sk pk msg nonce =
   try Some (Sodium.Box.Bigbytes.box_open sk pk msg nonce) with
     | Sodium.Verification_failure -> None
 
+let make_target target =
+  if List.length target > 8 then raise TargetNot256Bit ;
+  target
+
+(* Compare a SHA256 hash to a 256bits-target prefix.
+   The prefix is a list of "unsigned" int64. *)
+let compare_target hash target =
+  let hash = Hash.Generic_hash.to_string hash in
+  let rec check offset = function
+    | [] -> true
+    | x :: xs ->
+        Compare.Uint64.(EndianString.BigEndian.get_int64 hash offset < x)
+        && check (offset + 8) xs in
+  check 0 target
+
+let default_target =
+  (* FIXME we use an easy target until we allow custom configuration. *)
+  [ Int64.shift_left 1L 48 ]
+
+let check_proof_of_work pk nonce target =
+  let hash =
+    Hash.Generic_hash.hash_bytes [
+      Sodium.Box.Bigbytes.of_public_key pk ;
+      Sodium.Box.Bigbytes.of_nonce nonce ;
+    ] in
+  compare_target hash target
+
+let generate_proof_of_work pk target =
+  let rec loop nonce =
+    if check_proof_of_work pk nonce target then nonce
+    else loop (increment_nonce nonce) in
+  loop (random_nonce ())
+
 let public_key_encoding =
   let open Data_encoding in
     conv
@@ -44,4 +79,3 @@ let nonce_encoding =
       Sodium.Box.Bigbytes.of_nonce
       Sodium.Box.Bigbytes.to_nonce
       (Fixed.bytes Sodium.Box.nonce_size)
-

src/utils/crypto_box.mli

@@ -13,9 +13,12 @@ type nonce
 
 val random_nonce : unit -> nonce
 val increment_nonce : ?step:int -> nonce -> nonce
-
 val nonce_encoding : nonce Data_encoding.t
 
+type target
+val make_target : (* unsigned *) Int64.t list -> target
+val default_target : target
+
 type secret_key
 type public_key
 
@@ -28,3 +31,5 @@ val box : secret_key -> public_key -> MBytes.t -> nonce -> MBytes.t
 
 val box_open : secret_key -> public_key -> MBytes.t -> nonce -> MBytes.t option
 
+val check_proof_of_work : public_key -> nonce -> target -> bool
+val generate_proof_of_work : public_key -> target -> nonce

src/utils/hash.ml

@@ -13,6 +13,17 @@ let (>|=) = Lwt.(>|=)
 
 open Utils
 
+let () =
+  let expected_primitive = "blake2b"
+  and primitive = Sodium.Generichash.primitive in
+  if primitive <> expected_primitive then begin
+    Printf.eprintf
+      "FATAL ERROR: \
+       invalid value for Sodium.Generichash.primitive: %S (expected %S)@."
+      primitive expected_primitive ;
+    exit 1
+  end
+
 (*-- Signatures -------------------------------------------------------------*)
 
 module type MINIMAL_HASH = sig
@@ -27,10 +38,10 @@ module type MINIMAL_HASH = sig
   val size: int (* in bytes *)
   val compare: t -> t -> int
   val equal: t -> t -> bool
-  val of_raw: string -> t
-  val to_raw: t -> string
   val of_hex: string -> t
   val to_hex: t -> string
+  val of_string: string -> t
+  val to_string: t -> string
   val to_bytes: t -> MBytes.t
   val of_bytes: MBytes.t -> t
   val read: MBytes.t -> int -> t
@@ -60,6 +71,7 @@ end
 module type Name = sig
   val name: string
   val title:  string
+  val size: int option
 end
 
 module type PrefixedName = sig
@@ -69,56 +81,61 @@ end
 
 (*-- Type specific Hash builder ---------------------------------------------*)
 
-module Make_minimal_SHA256 (K : Name) = struct
+module Make_minimal_Blake2B (K : Name) = struct
 
-  type t = string
+  type t = Sodium.Generichash.hash
 
   include K
 
-  let size = 32 (* SHA256 *)
+  let size =
+    match K.size with
+    | None -> 32
+    | Some x -> x
 
-  let of_raw s =
+  let of_string s =
     if String.length s <> size then begin
       let msg =
-        Printf.sprintf "%s.of_raw: wrong string size for %S (%d)"
+        Printf.sprintf "%s.of_string: wrong string size (%d)"
-          K.name s (String.length s) in
+          K.name (String.length s) in
       raise (Invalid_argument msg)
-    end;
+    end ;
-    s
+    Sodium.Generichash.Bytes.to_hash (Bytes.of_string s)
-  let to_raw s = s
+  let to_string s = Bytes.to_string (Sodium.Generichash.Bytes.of_hash s)
 
-  let of_hex s = of_raw (Hex_encode.hex_decode s)
+  let of_hex s = of_string (Hex_encode.hex_decode s)
-  let to_hex s = Hex_encode.hex_encode s
+  let to_hex s = Hex_encode.hex_encode (to_string s)
 
-  let compare = String.compare
+  let compare = Sodium.Generichash.compare
-  let equal : t -> t -> bool = (=)
+  let equal x y = compare x y = 0
 
   let of_bytes b =
-    let s = MBytes.to_string b in
+    if MBytes.length b <> size then begin
-    if String.length s <> size then begin
       let msg =
-        Printf.sprintf "%s.of_bytes: wrong string size for %S (%d)"
+        Printf.sprintf "%s.of_bytes: wrong string size (%d)"
-          K.name s (String.length s) in
+          K.name (MBytes.length b) in
       raise (Invalid_argument msg)
-    end;
+    end ;
-    s
+    Sodium.Generichash.Bigbytes.to_hash b
-  let to_bytes = MBytes.of_string
+  let to_bytes = Sodium.Generichash.Bigbytes.of_hash
 
-  let read src off = MBytes.substring src off size
+  let read src off = of_bytes @@ MBytes.sub src off size
-  let write dst off h = MBytes.blit_from_string h 0 dst off size
+  let write dst off h = MBytes.blit (to_bytes h) 0 dst off size
 
   let hash_bytes l =
-    let hash = Cryptokit.Hash.sha256 () in
+    let open Sodium.Generichash in
-    (* FIXME... bigstring... *)
+    let state = init ~size () in
-    List.iter (fun b -> hash#add_string (MBytes.to_string b)) l;
+    List.iter (Bigbytes.update state) l ;
-    let r = hash#result in hash#wipe; r
+    final state
 
   let hash_string l =
-    let hash = Cryptokit.Hash.sha256 () in
+    let open Sodium.Generichash in
-    List.iter (fun b -> hash#add_string b) l;
+    let state = init ~size () in
-    let r = hash#result in hash#wipe; r
+    List.iter
+      (fun s -> Bytes.update state (BytesLabels.unsafe_of_string s))
+      l ;
+    final state
 
-  module Set = Set.Make(struct type t = string let compare = compare end)
+  module Set = Set.Make(struct type nonrec t = t let compare = compare end)
 
   let fold_read f buf off len init =
     let last = off + len * size in
@@ -133,12 +150,15 @@ module Make_minimal_SHA256 (K : Name) = struct
     in
     loop init off
 
-  module Map = Map.Make(struct type t = string let compare = compare end)
+  module Map = Map.Make(struct type nonrec t = t let compare = compare end)
   module Table =
-    (* TODO improve *)
     Hashtbl.Make(struct
-      type t = string
+      type nonrec t = t
-      let hash s = Int64.to_int (EndianString.BigEndian.get_int64 s 0)
+      let hash s =
+        Int64.to_int
+          (EndianString.BigEndian.get_int64
+             (Bytes.unsafe_to_string (Sodium.Generichash.Bytes.of_hash s))
+             0)
       let equal = equal
     end)
 
@@ -153,7 +173,7 @@ module Make_minimal_SHA256 (K : Name) = struct
     of_hex path
 
   let prefix_path p =
-    let p = to_hex p in
+    let p = Hex_encode.hex_encode p in
     let len = String.length p in
     let p1 = if len >= 2 then String.sub p 0 2 else ""
     and p2 = if len >= 4 then String.sub p 2 2 else ""
@@ -165,7 +185,7 @@ module Make_minimal_SHA256 (K : Name) = struct
 
 end
 
-module Make_SHA256 (R : sig
+module Make_Blake2B (R : sig
     val register_encoding:
       prefix: string ->
       to_raw: ('a -> string) ->
@@ -174,7 +194,7 @@ module Make_SHA256 (R : sig
       'a Base48.encoding
   end) (K : PrefixedName) = struct
 
-  include Make_minimal_SHA256(K)
+  include Make_minimal_Blake2B(K)
 
   (* Serializers *)
 
@@ -183,8 +203,8 @@ module Make_SHA256 (R : sig
   let b48check_encoding =
     R.register_encoding
       ~prefix: K.b48check_prefix
-      ~wrap: (fun x -> Hash x)
+      ~wrap: (fun s -> Hash s)
-      ~of_raw:(fun s -> Some s) ~to_raw
+      ~of_raw:(fun h -> Some (of_string h)) ~to_raw:to_string
 
   let of_b48check s =
     match Base48.simple_decode b48check_encoding s with
@@ -240,7 +260,7 @@ module Hash_table (Hash : HASH)
     type t = Hash.t
     let equal = Hash.equal
     let hash v =
-      let raw_hash = Hash.to_raw v in
+      let raw_hash = Hash.to_string v in
       let int64_hash = EndianString.BigEndian.get_int64 raw_hash 0 in
       Int64.to_int int64_hash
   end)
@@ -248,10 +268,11 @@ module Hash_table (Hash : HASH)
 (*-- Pre-instanciated hashes ------------------------------------------------*)
 
 module Block_hash =
-  Make_SHA256 (Base48) (struct
+  Make_Blake2B (Base48) (struct
     let name = "Block_hash"
     let title = "A Tezos block ID"
     let b48check_prefix = Base48.Prefix.block_hash
+    let size = None
   end)
 
 module Block_hash_set = Hash_set (Block_hash)
@@ -259,10 +280,11 @@ module Block_hash_map = Hash_map (Block_hash)
 module Block_hash_table = Hash_table (Block_hash)
 
 module Operation_hash =
-  Make_SHA256 (Base48) (struct
+  Make_Blake2B (Base48) (struct
     let name = "Operation_hash"
     let title = "A Tezos operation ID"
     let b48check_prefix = Base48.Prefix.operation_hash
+    let size = None
    end)
 
 module Operation_hash_set = Hash_set (Operation_hash)
@@ -270,12 +292,21 @@ module Operation_hash_map = Hash_map (Operation_hash)
 module Operation_hash_table = Hash_table (Operation_hash)
 
 module Protocol_hash =
-  Make_SHA256 (Base48) (struct
+  Make_Blake2B (Base48) (struct
     let name = "Protocol_hash"
     let title = "A Tezos protocol ID"
     let b48check_prefix = Base48.Prefix.protocol_hash
+    let size = None
   end)
 
 module Protocol_hash_set = Hash_set (Protocol_hash)
 module Protocol_hash_map = Hash_map (Protocol_hash)
 module Protocol_hash_table = Hash_table (Protocol_hash)
+
+module Generic_hash =
+  Make_minimal_Blake2B (struct
+    let name = "Generic_hash"
+    let title = ""
+    let size = None
+  end)
+

src/utils/hash.mli

@@ -13,7 +13,7 @@
 (** {2 Hash Types} ************************************************************)
 
 (** The signature of an abstract hash type, as produced by functor
-    {!Make_SHA256}. The {!t} type is abstracted for separating the
+    {!Make_Blake2B}. The {!t} type is abstracted for separating the
     various kinds of hashes in the system at typing time. Each type is
     equipped with functions to use it as is of as keys in the database
     or in memory sets and maps. *)
@@ -30,10 +30,10 @@ module type MINIMAL_HASH = sig
   val size: int (* in bytes *)
   val compare: t -> t -> int
   val equal: t -> t -> bool
-  val of_raw: string -> t
-  val to_raw: t -> string
   val of_hex: string -> t
   val to_hex: t -> string
+  val of_string: string -> t
+  val to_string: t -> string
   val to_bytes: t -> MBytes.t
   val of_bytes: MBytes.t -> t
   val read: MBytes.t -> int -> t
@@ -63,12 +63,13 @@ end
 (** {2 Building Hashes} *******************************************************)
 
 (** The parameters for creating a new Hash type using
-    {!Make_SHA256}. Both {!name} and {!title} are only informative,
+    {!Make_Blake2B}. Both {!name} and {!title} are only informative,
     used in error messages and serializers. *)
 
 module type Name = sig
   val name : string
   val title : string
+  val size : int option
 end
 
 module type PrefixedName = sig
@@ -77,8 +78,8 @@ module type PrefixedName = sig
 end
 
 (** Builds a new Hash type using Sha256. *)
-module Make_minimal_SHA256 (Name : Name) : MINIMAL_HASH
+module Make_minimal_Blake2B (Name : Name) : MINIMAL_HASH
-module Make_SHA256
+module Make_Blake2B
     (Register : sig
        val register_encoding:
          prefix: string ->
@@ -132,3 +133,4 @@ module Protocol_hash_set : module type of Hash_set (Protocol_hash)
 module Protocol_hash_map : module type of Hash_map (Protocol_hash)
 module Protocol_hash_table : module type of Hash_table (Protocol_hash)
 
+module Generic_hash : MINIMAL_HASH

test/Makefile

@@ -28,7 +28,6 @@ PACKAGES := \
   cohttp.lwt \
   compiler-libs.optcomp \
   config-file \
-  cryptokit \
   cstruct \
   dynlink \
   ezjsonm \

test/attic/test_p2p.ml

@@ -1,6 +1,6 @@
 (*
 ocamlfind ocamlopt \
-   -package 'lwt,lwt.unix,lwt.log,ezjsonm,ocplib-endian,config-file,cryptokit,cstruct' \
+   -package 'lwt,lwt.unix,lwt.log,ezjsonm,ocplib-endian,config-file,cstruct' \
   ../core/utils.cmx ../core/logs.cmx ../core/mMBytes.cmx ../core/json.cmx \
   netbits.cmx p2p.cmx test_p2p.ml -linkpkg \
   -o test_p2p && ./test_p2p

test/test_context.ml

@@ -18,11 +18,11 @@ let (//) = Filename.concat
 
 let genesis_block =
   Block_hash.of_b48check
-    "eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
+    "eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
 
 let genesis_protocol =
   Protocol_hash.of_b48check
-    "2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK"
+    "2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
 
 let genesis_time =
   Time.of_seconds 0L

test/test_state.ml

@@ -16,11 +16,11 @@ let (//) = Filename.concat
 
 let genesis_block =
   Block_hash.of_b48check
-    "eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
+    "eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
 
 let genesis_protocol =
   Protocol_hash.of_b48check
-    "2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK"
+    "2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
 
 let genesis_time =
   Time.of_seconds 0L

test/test_store.ml

@@ -18,11 +18,11 @@ let (//) = Filename.concat
 
 let genesis_block =
   Block_hash.of_b48check
-    "eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
+    "eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
 
 let genesis_protocol =
   Protocol_hash.of_b48check
-    "2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK"
+    "2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
 
 let genesis_time =
   Time.of_seconds 0L
@@ -89,10 +89,10 @@ let bh2 = Store.Block.hash b2.data
 let b3 = lolblock ~operations:[oph1;oph2] "Persil"
 let bh3 = Store.Block.hash b3.data
 let bh3' =
-  let raw = Bytes.of_string @@ Block_hash.to_raw bh3 in
+  let raw = Bytes.of_string @@ Block_hash.to_string bh3 in
   Bytes.set raw 31 '\000' ;
   Bytes.set raw 30 '\000' ;
-  Block_hash.of_raw @@ Bytes.to_string raw
+  Block_hash.of_string @@ Bytes.to_string raw
 
 let check_block s h b =
   Block.full_get s h >>= function