fix denomination hash

src/api.ml

@@ -10,7 +10,6 @@
 open Time
 open Crypto
 open Signatures
-module DenominationHash = Hash.DenominationHash
 
 let encode jsont v = Jsont_bytesrw.encode_string jsont v
 let decode jsont v = Jsont_bytesrw.decode_string jsont v
@@ -296,8 +295,6 @@ end
 module DenominationKey = struct
   type t = Rsa of RsaDenominationKey.t
 
-  let to_octets = function Rsa denom -> RsaPublicKey.to_octets denom.rsa_pub
-
   let of_cs _v =
     Jsont.Error.msg Jsont.Meta.none "CSDenominationKey are not supported"
 

src/crypto.ml

@@ -209,13 +209,12 @@ module RsaPublicKey = struct
   let of_octets = Binary_format_rsa.pub_of_octets
   let to_b32 t = B32.encode (to_octets t)
 
-  let jsont =
-    let of_b32 s =
-      let* s = B32.decode s in
-      let+ v = of_octets s in
-      v
-    in
-    Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
+  let of_b32 s =
+    let* s = B32.decode s in
+    let+ v = of_octets s in
+    v
+
+  let jsont = Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32
 
   let caqti : t Caqti_type.t =
     Caqti_type.custom
@@ -257,6 +256,63 @@ module RsaSignature = struct
     Jsont.of_of_string ~kind:"RsaSignature" of_b32 ~enc:to_b32
 end
 
+module DenominationHash : sig
+  type t
+
+  val bin : t Bin.t
+  val caqti : t Caqti_type.t
+  val jsont : t Jsont.t
+  val hash_of_rsa : RsaPublicKey.t -> 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 = struct
+  open Digestif
+
+  type t = SHA512.t
+
+  (* = GNUNET_CRYPTO_BSA_(RSA|CS) *)
+  type cipher =
+    | RSA
+    | CS [@ocaml.warning "-37"]
+
+  let cipher_to_int32 = function RSA -> 1_l | CS -> 2_l
+
+  let hash_of_rsa pub =
+    let age_mask = 0_l in
+    let cipher = cipher_to_int32 RSA in
+    let pub = RsaPublicKey.to_octets pub in
+    let pub_len = String.length pub in
+    let b = Bytes.create (2 + 2 + pub_len) in
+    Bytes.set_int32_be b 0 age_mask;
+    Bytes.set_int32_be b 2 cipher;
+    Bytes.blit_string pub 0 b 4 pub_len;
+    SHA512.(digest_bytes b)
+
+  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
+
+  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:"DenominationHash" of_b32 ~enc:to_b32
+end
+
 (* some type aliases, just for prettier .mli *)
 type eddsa_priv = EddsaPrivateKey.t
 type eddsa_pub = EddsaPublicKey.t
@@ -264,4 +320,4 @@ type eddsa_sig = EddsaSignature.t
 type rsa_priv = RsaPrivateKey.t
 type rsa_pub = RsaPublicKey.t
 type rsa_sig = RsaSignature.t
-type denom_hash = Hash.DenominationHash.t
+type denom_hash = DenominationHash.t

src/denomination.ml

@@ -158,9 +158,7 @@ let denoms_of_denomgroups l =
                   lost= _;
                 }
               ->
-                let h_pub =
-                  DenominationHash.hash (Crypto.RsaPublicKey.to_octets rsa_pub)
-                in
+                let h_pub = DenominationHash.hash_of_rsa rsa_pub in
                 {
                   pub= rsa_pub;
                   value;

src/hash.ml

@@ -10,6 +10,7 @@ module type S = sig
   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
@@ -24,6 +25,7 @@ module H32 = struct
 
   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
@@ -37,9 +39,7 @@ module H32 = struct
       ~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
+  let jsont = Jsont.of_of_string ~kind:"Hash 32" of_b32 ~enc:to_b32
 end
 
 module H64 = struct
@@ -54,6 +54,7 @@ module H64 = struct
 
   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
@@ -67,9 +68,7 @@ module H64 = struct
       ~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
+  let jsont = Jsont.of_of_string ~kind:"Hash 64" of_b32 ~enc:to_b32
 end
 
 (* C-terminated strings
@@ -92,7 +91,6 @@ end
    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

src/http_management.ml

@@ -58,7 +58,7 @@ module Denom_revoke = struct
     Logs.info (fun m -> m "POST /management/denominations/$H_DENOM_PUB/revoke/");
     let keys = Vif.Server.device Devices.keys server in
     let res =
-      let* h_denom_pub = DenominationHash.of_b32 h_denom_pub in
+      let* h_denom_pub = Crypto.DenominationHash.of_b32 h_denom_pub in
       let* v = Vif.Request.of_json req |> unwrap_err_msg in
       let* () = verify keys h_denom_pub v in
       let* () = do_ keys h_denom_pub v in

src/keys.ml

@@ -119,8 +119,7 @@ module Make (Conn : Pg.CONN) : S = struct
 
   let make_future_dn (h_pub, (section_name, pub, start)) =
     Logs.debug (fun m ->
-        m "make_future_dn: `%s`"
-          (B32.encode @@ Hash.DenominationHash.to_octets h_pub));
+        m "make_future_dn: `%s`" (DenominationHash.to_b32 h_pub));
     let open Time in
     let Config.Coin.
           {
@@ -320,7 +319,7 @@ module Make (Conn : Pg.CONN) : S = struct
             let+ () = Pg.insert_denom conn dn |> unwrap_err_caqti in
             Logs.info (fun m ->
                 m "certified denomination `%s`"
-                  (B32.encode @@ Hash.DenominationHash.to_octets dn.h_pub));
+                  (DenominationHash.to_b32 dn.h_pub));
             ())
 
   let revoke_signkey pub revoked_sig =
@@ -342,7 +341,6 @@ module Make (Conn : Pg.CONN) : S = struct
       |> unwrap_err_caqti
     in
     Logs.info (fun m ->
-        m "revoked denomination `%s`"
-          (B32.encode @@ Hash.DenominationHash.to_octets h_pub));
+        m "revoked denomination `%s`" (DenominationHash.to_b32 h_pub));
     ()
 end

src/secmod_rsa.ml

@@ -7,7 +7,6 @@ module Log = (val Logs.src_log src : Logs.LOG)
 open Syntax
 open Crypto
 open Time
-module DenominationHash = Hash.DenominationHash
 
 module Cfg = struct
   open Config
@@ -125,7 +124,7 @@ let get_key_dir_contents dir_fpath =
 let gen_key ~section_name t1 t2 =
   let bits = Cfg.rsa_keysize ~section_name in
   let priv, pub = RsaPrivateKey.generate ~bits () in
-  let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in
+  let h_pub = DenominationHash.hash_of_rsa pub in
   Log.debug (fun m ->
       m "generated key (%a):@,`%s`" pp_filename (t1, t2)
         (DenominationHash.to_octets h_pub |> B32.encode));
@@ -179,7 +178,7 @@ let load_key ~section_name fpath =
   | Some (t1, t2) ->
       let+ priv = read_rsa fpath in
       let pub = RsaPrivateKey.pub_of_priv priv in
-      let h_pub = DenominationHash.hash (RsaPublicKey.to_octets pub) in
+      let h_pub = DenominationHash.hash_of_rsa pub in
       { section_name; priv; pub; h_pub; t1; t2 }
 
 let load_section section_name =

src/signatures.ml

@@ -2,7 +2,7 @@ open Time
 open Hash
 
 module Aliases = struct
-  (* - Keys - *)
+  module DenominationHash = Crypto.DenominationHash
 
   (* some of those are actuall ecdhe, or union of eddsa|ecdhe *)
   open Crypto