wip debug

.jjconflict-side-1/src/hash.ml

@@ -0,0 +1,108 @@
+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
+end
+
+module H32 = struct
+  type t = SHA256.t
+
+  let hash s = SHA256.(digest_string s)
+
+  let of_octets s =
+    match String.length s = 32 with
+    | false -> Fmt.failwith "Hash.of_octets failure: data is not 32 bytes"
+    | true -> SHA256.of_raw_string s
+
+  let to_octets = SHA256.to_raw_string
+  let of_b32 s = Result.map of_octets (B32.decode s)
+
+  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 =
+    let enc v = B32.encode (to_octets v) in
+    Jsont.of_of_string ~kind:"Hash 32" of_b32 ~enc
+end
+
+module H64 = struct
+  type t = SHA512.t
+
+  let hash s = SHA512.(digest_string s)
+
+  let of_octets s =
+    match String.length s = 64 with
+    | false -> Fmt.failwith "Hash.of_octets failure: data is not 64 bytes"
+    | true -> SHA512.of_raw_string s
+
+  let to_octets v =
+    let s = SHA512.to_raw_string v in
+    match String.length s = 64 with
+    | false -> Fmt.failwith "Hash.to_octets failure: data is not 64 bytes"
+    | true -> s
+
+  let of_b32 s = Result.map of_octets (B32.decode s)
+
+  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 =
+    let enc v = B32.encode (to_octets v) in
+    Jsont.of_of_string ~kind:"Hash 64" of_b32 ~enc
+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 DenominationHash : S = H64
+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