Source file hash.ml

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2019,2020 DaiLambda, Inc. <contact@dailambda.jp>            *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module Prefix : sig
  type t

  val to_string : t -> string
  val of_string : string -> t

  val length : t -> int

  val overwrite_last_2bits : t -> int -> t

  val zero : int -> t

  val to_hex_string : t -> string

  (** may fail *)
  val of_hex_string : string -> t

  val show_ref : (t -> string) ref

  val show : t -> string

  val encoding : int -> t Data_encoding.t

  val gen : int -> t Gen.t

  val pp : Format.formatter -> t -> unit

  val to_32byte_string : t -> string
end = struct
  type t = string

  let to_string x = x

  let of_string x = x

  let length = String.length

  let overwrite_last_2bits hp bb =
    let bs = Bytes.unsafe_of_string hp in
    let pos = String.length hp - 1 in
    Bytes.unsafe_set bs pos
    @@ Char.(chr @@
             (code (Bytes.unsafe_get bs pos) land 0xfc)
             lor (bb land 0x03));
    Bytes.unsafe_to_string bs

  let zero nbytes = of_string (String.make nbytes '\000')

  let to_hex_string s =
    let `Hex h = Hex.of_string s in
    h

  let of_hex_string h = Hex.to_string (`Hex h)

  let show_ref = ref to_hex_string

  let show h = !show_ref h

  let encoding sz = Data_encoding.(conv Bytes.of_string Bytes.to_string @@ Fixed.bytes sz)

  let gen bytes : t Gen.t = Gen.(string (return bytes) char)

  let pp ppf h = Format.pp_print_string ppf @@ show h

  let to_32byte_string t =
    let len = length t in
    if len = 32 then t
    else begin
      assert (len < 32);
      t ^ String.make (32 - len) '\000'
    end
end

type t = Prefix.t * string

let () = assert (Limit.max_hash_postfix_bytes <= 255)

let encoding size : t Data_encoding.t =
  let open Data_encoding in
  let postfix =
    conv Bytes.of_string Bytes.to_string @@ Bounded.bytes Limit.max_hash_postfix_bytes
  in
  tup2 (Prefix.encoding size) postfix

let to_hex_string t =
  let to_string (s, s') = Prefix.to_string s ^ s' in
  let `Hex s = Hex.of_string @@ to_string t in s

let pp ppf t = Format.pp_print_string ppf @@ to_hex_string t

let of_prefix h = h, ""

let prefix : t -> Prefix.t = fst

let is_long = function
  | _, "" -> false
  | _ -> true

let to_strings = function
  | s, "" -> [Prefix.to_string s]
  | s, s' -> [Prefix.to_string s; s']

module Hasher = struct
  type t =
    { bytes : int (* hash size in bytes *)
    ; hash_func : [`Blake2B | `Blake3]

    ; compute : flags: int -> string list -> Prefix.t

    ; zero : Prefix.t (* bytes length of 0s *)

    ; flags_combined : bool

    ; hash_of_empty_leaf : Prefix.t
    }

  let is_compatible t1 t2 =
    t1.bytes = t2.bytes
    && t1.hash_func = t2.hash_func
    && t1.flags_combined = t2.flags_combined

  let make ~bytes_per_cell ~hash_func ~bytes_per_hash ~with_count =
    (* Ghash.Make'((val hf))(struct let bytes = bytes end) in *)
    (* XXX code should be moved to node_storage.ml *)
    let count = if with_count then 4 else 0 in
    let flags_combined =
      if not (bytes_per_hash + 4 (* index *) + count <= bytes_per_cell) then begin
        Format.eprintf "bytes_per_hash: %d count: %d bytes_per_cell: %d@."
          bytes_per_hash count bytes_per_cell;
        assert false
      end;
      bytes_per_hash + 4 (* index *) + count = bytes_per_cell
    in
    let module H = (val Hashfunc.make hash_func bytes_per_hash : Hashfunc_intf.S) in
    let compute ~flags ss =
      if flags_combined then
        Prefix.overwrite_last_2bits (Prefix.of_string @@ H.hash_strings ss) flags
      else
        Prefix.of_string @@ H.hash_strings (String.make 1 (Char.chr flags) :: ss)
    in
    { bytes= bytes_per_hash
    ; hash_func
    ; compute
    ; zero = Prefix.zero bytes_per_hash
    ; flags_combined
    ; hash_of_empty_leaf = compute ~flags:0b10 [""]
    }
end