fix exchange_sig: correctly group and order denominations

src/api.ml

@@ -1229,10 +1229,6 @@ module ExchangeKeysResponse = struct
     hard_limits: AccountLimit.t list;
     zero_limits: ZeroLimitedOperation.t list;
     denominations: DenomGroup.t list;
-    (* Compact EdDSA signature (binary-only) over the
-       contatentation of all of the master_sigs (in reverse
-       chronological order by group) in the arrays under
-       "denominations" *)
     exchange_sig: ExchangeKeySet.t;
     exchange_pub: EddsaPublicKey.t;
     recoup: RecoupDenoms.t list;

src/denomination.ml

@@ -15,3 +15,98 @@ type t = {
   h_pub: denom_hash;
   master_sig: Signatures.DenominationKeyValidity.t;
 }
+
+let make_denom_group_sorted denominations =
+  let open Syntax in
+  let ht = Hashtbl.create 0xff in
+  List.iter
+    (fun coin ->
+      let open Config.Coin in
+      assert (coin.cipher = `RSA);
+      let k =
+        ( coin.value,
+          coin.fee_withdraw,
+          coin.fee_deposit,
+          coin.fee_refresh,
+          coin.fee_refund )
+      in
+      let v = [] in
+      Hashtbl.replace ht k v)
+    Config.Coin.all_coins;
+  let+ () =
+    list_iter
+      (fun {
+             pub;
+             value;
+             stamp_start;
+             stamp_expire_withdraw;
+             stamp_expire_deposit;
+             stamp_expire_legal;
+             fee_withdraw;
+             fee_deposit;
+             fee_refresh;
+             fee_refund;
+             age_mask= _;
+             h_pub= _;
+             master_sig;
+           } ->
+        let k = (value, fee_withdraw, fee_deposit, fee_refresh, fee_refund) in
+        let v =
+          Api.RsaDenom.
+            {
+              rsa_pub= pub;
+              master_sig;
+              stamp_start;
+              stamp_expire_withdraw;
+              stamp_expire_deposit;
+              stamp_expire_legal;
+              lost= None;
+            }
+        in
+        let+ l =
+          match Hashtbl.find_opt ht k with
+          | None ->
+              Error "denomination does not match any coin in configuration"
+          | Some l -> Ok l
+        in
+        Hashtbl.replace ht k (v :: l))
+      denominations
+  in
+
+  (* ! important for /keys .exchange_sig
+     each group must be ordered in _reverse_ chronological order
+     order of groups to compute hash, must be the same as the order
+     in /keys .denominations *)
+  let open Api in
+  let open DenomGroup in
+  let open RsaDenomGroup in
+  let open RsaDenom in
+  let cmp_denom b a = Timestamp.compare a.stamp_start b.stamp_start in
+  let cmp_group =
+    let cmp_amount a b =
+      let open Amount in
+      match Int64.unsigned_compare a.value b.value with
+      | 0 -> Int32.unsigned_compare a.fraction b.fraction
+      | n -> n
+    in
+    fun (Rsa a) (Rsa b) -> cmp_amount a.value b.value
+  in
+  let l =
+    Hashtbl.to_seq ht
+    |> List.of_seq
+    |> List.map
+         (fun
+           ((value, fee_withdraw, fee_deposit, fee_refresh, fee_refund), denoms)
+         ->
+           Rsa
+             {
+               denoms= List.sort cmp_denom denoms;
+               value;
+               fee_withdraw;
+               fee_deposit;
+               fee_refresh;
+               fee_refund;
+             })
+    |> List.sort cmp_group
+  in
+  l

src/http_info.ml

@@ -20,44 +20,6 @@ let config req _server _env =
   let res = Api.encode Api.ExchangeVersionResponse.jsont config in
   Respond.result res req
 
-(* TODO
-   for now we only have one item in each "denom group"
-   change this once we have denom/signkey rotation *)
-let denomgroup_of_denomdata
-    Denomination.
-      {
-        pub;
-        value;
-        stamp_start;
-        stamp_expire_withdraw;
-        stamp_expire_deposit;
-        stamp_expire_legal;
-        fee_withdraw;
-        fee_deposit;
-        fee_refresh;
-        fee_refund;
-        age_mask= _;
-        h_pub= _;
-        master_sig;
-      } =
-  let denoms =
-    [
-      RsaDenom.
-        {
-          rsa_pub= pub;
-          master_sig;
-          stamp_start;
-          stamp_expire_withdraw;
-          stamp_expire_deposit;
-          stamp_expire_legal;
-          lost= None;
-        };
-    ]
-  in
-  DenomGroup.Rsa
-    RsaDenomGroup.
-      { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund }
-
 let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date =
   let version = Api.protocol_version in
   let base_url = Config.base_url in
@@ -70,89 +32,72 @@ let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date =
   let stefan_abs = Config.stefan_abs in
   let stefan_log = Config.stefan_log in
   let stefan_lin = Config.stefan_lin in
-  (* todo asset_type
-     Type of the asset. "fiat", "crypto", "regional" or "stock". *)
-  let asset_type = "xxx" in
+  (* type of the asset. "fiat", "crypto", "regional" or "stock". *)
+  let asset_type = "fiat" in
   let* accounts = Pg.get_wire_accounts db_conn () |> unwrap_err_caqti in
   let* wire_fees =
-    (* todo
-       where does wire_methods comes from? *)
-    let wire_method = "xxx" in
+    (* wire_methods? *)
+    let wire_method = "x-taler-bank" in
     let+ wire_fees =
       Pg.get_wire_fees db_conn ~wire_method |> unwrap_err_caqti
     in
     String_map.singleton wire_method wire_fees
   in
-  let wads =
-    (* TODO wads *)
-    []
-  in
+  let wads = [] in
   let rewards_allowed = false in
   let kyc_enabled = false in
-  let disable_direct_deposit = (* todo *) false in
+  let disable_direct_deposit = false in
   let master_public_key = Config.master_public_key in
   let reserve_closing_delay = Config.Exchangedb.idle_reserve_expiration_time in
-  (* todo *)
   let wallet_balance_limit_without_kyc = None in
   let hard_limits = [] in
   let zero_limits = [] in
-  let* dn_l =
-    let+ l = Keys.denominations () in
-    (* reverse chronological order *)
-    List.sort
-      (fun a b -> Stdlib.compare b.Denomination.stamp_start a.stamp_start)
-      l
-  in
+
+  let* denom_l = Keys.denominations () in
   let list_issue_date =
-    match dn_l with
-    | [] -> Timestamp.never
-    | dn :: _ -> dn.Denomination.stamp_start
+    List.fold_left
+      (fun acc dn -> Timestamp.max acc dn.Denomination.stamp_start)
+      Timestamp.zero denom_l
   in
-  let denominations =
+  let denom_l =
     (* if `?last_issue_date` query param does not exactly match the `stamp_start`
        of one of the denomination keys, all keys are returned *)
-    let open Denomination in
-    let l =
+    let stamp_start_opt =
       match last_issue_date with
-      | None -> dn_l
-      | Some last_issue_date -> (
-          match
-            List.find_opt
-              (fun v -> Timestamp.compare v.stamp_start last_issue_date = 0)
-              dn_l
-          with
-          | None -> dn_l
-          | Some _ ->
-              List.filter
+      | None -> None
+      | Some timestamp ->
+          List.find_map
             (fun v ->
-                  Time.Timestamp.compare v.stamp_start last_issue_date >= 0)
-                dn_l)
+              if Timestamp.compare v.Denomination.stamp_start timestamp = 0 then
+                Some v.stamp_start
+              else None)
+            denom_l
     in
-    List.map denomgroup_of_denomdata l
+    match stamp_start_opt with
+    | None -> denom_l
+    | Some timestamp ->
+        List.filter
+          (fun v -> Timestamp.compare v.Denomination.stamp_start timestamp >= 0)
+          denom_l
   in
+  let* denominations = Denomination.make_denom_group_sorted denom_l in
 
-  let* signkeys =
-    let+ l = Keys.signkeys () in
-    l
-    |> List.sort (fun a b ->
-        let open Signkey in
-        Stdlib.compare b.stamp_start a.stamp_start)
-    |> List.map Api.SignKey.of_signkey
-  in
+  let* signkeys = Keys.signkeys () in
+  let signkeys = List.map Api.SignKey.of_signkey signkeys in
 
-  let exchange_pub =
   (* the eddsa pub key used to sign exchange_sig *)
+  let* exchange_pub =
     match signkeys with
-    | [] -> Fmt.failwith "exchange has no active signkey"
-    | sk :: _ -> sk.SignKey.key
+    | [] -> Fmt.error "exchange has no active signkey"
+    | sk :: _ -> Ok sk.SignKey.key
   in
+
+  (* ! depends on denominations order *)
   let exchange_sig =
-    (* Compact EdDSA signature (binary-only) over the
-       contatentation of all of the master_sigs (in reverse
-       chronological order by group) in the arrays under "denominations". *)
     let hc =
-      dn_l
-      |> List.map (fun dn -> dn.Denomination.master_sig)
+      denominations
+      |> List.map (fun (DenomGroup.Rsa g) -> g.RsaDenomGroup.denoms)
+      |> List.concat_map (List.map (fun dn -> dn.RsaDenom.master_sig))
       |> List.map Signatures.DenominationKeyValidity.to_octets
       |> String.concat ""
       |> Hash.H64.hash
@@ -161,13 +106,12 @@ let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date =
     signf (Keys.sign exchange_pub) R.{ list_issue_date; hc }
   in
 
-  let recoup = (* TODO /recoup *) [] in
+  let recoup = (* /recoup *) [] in
   let* global_fees =
     Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti
   in
   let* auditors =
-    (* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *)
-    (* does not contains auditor_keys with empty denomination_keys *)
+    (* /auditors/$AUDITOR_PUB/$H_DENOM_PUB *)
     Pg.get_auditor_keys db_conn
   in
   let extensions = None in
@@ -222,9 +166,7 @@ let keys req server _env =
       | [] -> Ok None
       | s :: _ -> (
           match Int64.of_string_opt s with
-          | None ->
-              Error
-                "invalid `?last_issue_date` query param, int_of_string failure"
+          | None -> Error "invalid `?last_issue_date` query param, not an int"
           | Some n -> Ok (Some (Timestamp.of_s n)))
     in
     let* v = mk_keys ~db_conn keys ~last_issue_date in

src/time.ml

@@ -99,6 +99,8 @@ module Timestamp = struct
   let never = uint64_max
   let zero = 0L
   let compare = Int64.unsigned_compare
+  let min a b = if compare a b < 0 then a else b
+  let max a b = if compare a b > 0 then a else b
 
   (* zero if a >= b; never if b=never; otherwise b - a *)
   let diff a b =

src/time.mli

@@ -38,6 +38,8 @@ module Timestamp : sig
   val never : t
   val zero : t
   val compare : t -> t -> int
+  val min : t -> t -> t
+  val max : t -> t -> t
   val diff : t -> t -> Relative.t
   val of_s : int64 -> t