mte/src/hash.ml

open Digestif

module type S = sig
  type t

  val bin : t Bin.t
  val caqti : t Caqti_type.t
  val jsont : t Jsont.t
  val hash : string -> t
  val of_octets : string -> t
  val to_octets : t -> string
  val of_b32 : B32.t -> (t, string) result
  val to_b32 : t -> B32.t
end

module H32 = struct
  type t = SHA256.t

  let hash s = SHA256.(digest_string s)

  let of_octets s =
    match SHA256.of_raw_string_opt s with
    | None -> Fmt.failwith "H32.of_octets failure"
    | Some t -> t

  let to_octets = SHA256.to_raw_string
  let of_b32 s = Result.map of_octets (B32.decode s)
  let to_b32 t = B32.encode (to_octets t)

  let bin =
    let open Bin in
    map (bytes 32) of_octets to_octets

  (* hashes are not b32 encoded in the database *)
  let caqti =
    let open Caqti_type in
    custom
      ~encode:(fun v -> Ok (to_octets v))
      ~decode:(fun v -> Ok (of_octets v))
      octets

  let jsont = Jsont.of_of_string ~kind:"Hash 32" of_b32 ~enc:to_b32
end

module H64 = struct
  type t = SHA512.t

  let hash s = SHA512.(digest_string s)

  let of_octets s =
    match SHA512.of_raw_string_opt s with
    | None -> Fmt.failwith "H64.of_octets failure"
    | Some t -> t

  let to_octets = SHA512.to_raw_string
  let of_b32 s = Result.map of_octets (B32.decode s)
  let to_b32 t = B32.encode (to_octets t)

  let bin =
    let open Bin in
    map (bytes 64) of_octets to_octets

  (* hashes are not b32 encoded in the database *)
  let caqti =
    let open Caqti_type in
    custom
      ~encode:(fun v -> Ok (to_octets v))
      ~decode:(fun v -> Ok (of_octets v))
      octets

  let jsont = Jsont.of_of_string ~kind:"Hash 64" of_b32 ~enc:to_b32
end

(* C-terminated strings
   some strings need to be hashed with a '\0' termination char *)
module Cstring = struct
  module H32 = struct
    include H32

    let hash s = hash (s ^ "\x00")
  end

  module H64 = struct
    include H64

    let hash s = hash (s ^ "\x00")
  end
end

(* TODO
   check which hash algorithm to use for each hash type *)
module FullPaytoHash : S = H32
module NormalizedPaytoHash : S = H32
module PrivateContractHash : S = H64
module ExtensionsPolicyHash : S = H64
module MerchantWireHash : S = H64
module AgeCommitmentHash : S = H64
module BlindedCoinHash : S = H64
module CoinPubHash : S = H64
module OutputCommitmentHash : S = H64
module HashPlanchetsP : S = H64