src/config.ml

@@ -188,25 +188,8 @@ module Exchange_secmod_rsa = struct
 
   let lookahead_sign = get "lookahead_sign" |> duration
   let overlap_duration = get "overlap_duration" |> duration
-  let duration = get "duration" |> duration
   let key_dir = get "key_dir"
   let sm_priv_key = get "sm_priv_key"
-
-  (* only support one rsa_keysize *)
-  let rsa_keysize =
-    Coin.all_coins
-    |> List.map (fun coin -> coin.Coin.rsa_keysize)
-    |> List.sort_uniq Int.compare
-    |> function
-    | [] -> fail "no coin section found"
-    | a :: b :: _ ->
-        fail
-          "coins with different rsa_keysize are not supported, found \
-           rsa_keysize = %d and %d"
-          a b
-    | n :: [] -> n
-
-  let sections = Coin.all_coins |> List.map (fun coin -> coin.Coin.section_name)
 end
 
 module Exchange_secmod_eddsa = struct

src/secmod_rsa.ml

@@ -1,4 +1,6 @@
-(* TODO refacto common parts with secmod_eddsa *)
+(* TODO
+   refacto common parts with secmod_eddsa
+   use DenominationHash.t instead of rsa_pub? *)
 let src = Logs.Src.create "mte.secmod_rsa"
 
 module Log = (val Logs.src_log src : Logs.LOG)
@@ -7,7 +9,37 @@ module Log = (val Logs.src_log src : Logs.LOG)
 open Syntax
 open Crypto
 open Time
-module Cfg = Config.Exchange_secmod_rsa
+
+module Cfg = struct
+  open Config
+  include Exchange_secmod_rsa
+
+  let sections = Coin.all_coins |> List.map (fun coin -> coin.Coin.section_name)
+
+  (* helper functions to get config value from section_name: *)
+
+  let duration_withdraw =
+    let duration_withdraw_assoc =
+      Coin.all_coins
+      |> List.map (fun coin -> (coin.Coin.section_name, coin.duration_withdraw))
+    in
+    fun ~section_name ->
+      match List.assoc_opt section_name duration_withdraw_assoc with
+      | None ->
+          Fmt.failwith "section_name `%s` not found in config" section_name
+      | Some v -> v
+
+  let rsa_keysize =
+    let rsa_keysize_assoc =
+      Coin.all_coins
+      |> List.map (fun coin -> (coin.Coin.section_name, coin.rsa_keysize))
+    in
+    fun ~section_name ->
+      match List.assoc_opt section_name rsa_keysize_assoc with
+      | None ->
+          Fmt.failwith "section_name `%s` not found in config" section_name
+      | Some v -> v
+end
 
 type key = {
   section_name: string;
@@ -92,8 +124,9 @@ let get_key_dir_contents dir_fpath =
 
 (* -- *)
 
-let gen_key section_name t1 t2 =
+let gen_key ~section_name t1 t2 =
-  let priv, pub = RsaPrivateKey.generate ~bits:Cfg.rsa_keysize () in
+  let bits = Cfg.rsa_keysize ~section_name in
+  let priv, pub = RsaPrivateKey.generate ~bits () in
   Log.debug (fun m ->
       m "generated key (%s-%s):@,`%s`" (time_abs_to_string t1)
         (time_abs_to_string t2) (RsaPublicKey.to_b32 pub));
@@ -101,16 +134,16 @@ let gen_key section_name t1 t2 =
 
 let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
 
-let split_in_periodes ~start ~end_ =
+let split_in_periodes ~start ~end_ ~duration_withdraw =
   assert (start < end_);
   (* no overlap on first periode *)
   let t1 = start in
-  let t2 = Absolute.add start Cfg.duration in
+  let t2 = Absolute.add start duration_withdraw in
   let acc = [ (t1, t2) ] in
   let start = t2 in
   let rec go acc start end_ =
     let t1 = Absolute.sub start Cfg.overlap_duration in
-    let t2 = Absolute.add start Cfg.duration in
+    let t2 = Absolute.add start duration_withdraw in
     if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
   in
   go acc start end_
@@ -126,9 +159,10 @@ let gen_additional_keys_until_lookahead ~now ~section_name l =
   let end_ = Absolute.add now Cfg.lookahead_sign in
   if Absolute.compare start end_ >= 0 then []
   else
-    let periodes = split_in_periodes ~start ~end_ in
+    let duration_withdraw = Cfg.duration_withdraw ~section_name in
+    let periodes = split_in_periodes ~start ~end_ ~duration_withdraw in
     let new_keys =
-      List.map (fun (t1, t2) -> gen_key section_name t1 t2) periodes
+      List.map (fun (t1, t2) -> gen_key ~section_name t1 t2) periodes
     in
     new_keys
 
@@ -227,7 +261,7 @@ module Make () = struct
     |> list_iter delete
 
   let add section_name t1 t2 =
-    let k = gen_key section_name t1 t2 in
+    let k = gen_key ~section_name t1 t2 in
     Hashtbl.replace t.ht k.pub k;
     ()