src/secmod_rsa.ml

@@ -5,6 +5,7 @@ open Time
 module Cfg = Config.Exchange_secmod_rsa
 
 type key = {
+  section_name: string;
   priv: RsaPrivateKey.t;
   pub: RsaPublicKey.t;
   t1: Absolute.t;
@@ -14,7 +15,7 @@ type key = {
 type t = {
   sm_key_priv: EddsaPrivateKey.t;
   sm_key_pub: EddsaPublicKey.t;
-  mutable keys: key list;
+  mutable denoms: (string * key list) list;
 }
 
 (* -- util -- *)
@@ -44,7 +45,7 @@ let key_fpath k =
   let t1 = time_abs_to_string k.t1 in
   let t2 = time_abs_to_string k.t2 in
   let fname = Fmt.str "%s-%s" t1 t2 in
-  Fpath.(v Cfg.key_dir / fname)
+  Fpath.(v Cfg.key_dir / k.section_name / fname)
 
 (* -- IO -- *)
 
@@ -72,13 +73,13 @@ let delete_key_file k =
   in
   ()
 
-let get_key_dir_contents dir =
+let get_key_dir_contents dir_fpath =
-  let* dir = Fpath.of_string dir |> unwrap_err_msg in
+  let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in
-  let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
   if b then
-    Logs.info (fun m -> m "secmod_rsa: created directory `%a`" Fpath.pp dir);
+    Logs.info (fun m ->
+        m "secmod_rsa: created directory `%a`" Fpath.pp dir_fpath);
   let+ l =
-    Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir |> unwrap_err_msg
+    Bos.OS.Dir.contents ~dotfiles:false ~rel:true dir_fpath |> unwrap_err_msg
   in
   l
 
@@ -100,7 +101,7 @@ let split_in_periodes ~start ~end_ =
   in
   go acc start end_
 
-let gen_additional_keys_until_lookahead ~now l =
+let gen_additional_keys_until_lookahead ~now (section_name, l) =
   (* try to _not_ generate keys with validity start in the past
      (probably not important) *)
   let start =
@@ -115,7 +116,7 @@ let gen_additional_keys_until_lookahead ~now l =
       (fun (t1, t2) ->
         (* TODO ~bits is in coin's config *)
         let priv, pub = RsaPrivateKey.generate ~bits:2048 () in
-        { priv; pub; t1; t2 })
+        { section_name; priv; pub; t1; t2 })
       periodes
   in
   new_keys
@@ -128,7 +129,7 @@ let sm_key_fpath =
 
 (* we load sm_key separately
    we don't accept non-key files in key_dir *)
-let load_key fpath =
+let load_key ~section_name fpath =
   match Fpath.equal (Fpath.normalize fpath) sm_key_fpath with
   | true -> Ok None
   | false -> (
@@ -137,18 +138,25 @@ let load_key fpath =
       | Some (t1, t2) ->
           let* priv = read_rsa fpath in
           let pub = RsaPrivateKey.pub_of_priv priv in
-          Ok (Some { priv; pub; t1; t2 }))
+          Ok (Some { section_name; priv; pub; t1; t2 }))
+
+let load_section section_fpath =
+  let section_name = Fpath.filename section_fpath in
+  let* l = get_key_dir_contents section_fpath in
+  let* l = list_map (load_key ~section_name) l in
+  let keys = List.filter_map Fun.id l in
+  Ok (section_name, keys)
 
 let load () =
-  let* l = get_key_dir_contents Cfg.key_dir in
+  let* l = get_key_dir_contents (Fpath.v Cfg.key_dir) in
-  let* l = list_map load_key l in
+  (* TODO check/filter on section_name directories *)
-  let keys = List.filter_map Fun.id l in
+  let* denoms = list_map load_section l in
-  match keys with
+  match denoms with
   | [] -> Ok None
   | _l ->
       let* sm_key_priv = read_eddsa sm_key_fpath in
       let sm_key_pub = EddsaPrivateKey.pub_of_priv sm_key_priv in
-      Ok (Some { sm_key_priv; sm_key_pub; keys })
+      Ok (Some { sm_key_priv; sm_key_pub; denoms })
 
 let init () =
   let* opt = load () in
@@ -158,13 +166,44 @@ let init () =
     | None ->
         let sm_key_priv, sm_key_pub = EddsaPrivateKey.generate () in
         let* () = write_eddsa sm_key_fpath sm_key_priv in
-        Ok { sm_key_priv; sm_key_pub; keys= [] }
+        Ok { sm_key_priv; sm_key_pub; denoms= [] }
   in
+  (* TODO read from config *)
+  let sections = [] in
   let now = Absolute.of_ptime (Ptime_clock.now ()) in
-  let new_keys = gen_additional_keys_until_lookahead ~now t.keys in
+  let news =
-  let+ () = list_iter write_key new_keys in
+    List.map
-  let keys = sort_keys (t.keys @ new_keys) in
+      (fun section_name ->
-  { t with keys }
+        let v =
+          match List.find_opt (fun (s, _keys) -> s = section_name) t.denoms with
+          | None -> (section_name, [])
+          | Some v -> v
+        in
+        gen_additional_keys_until_lookahead ~now v)
+      sections
+  in
+  let+ () = list_iter (list_iter write_key) news in
+
+  (* TODO better data structure *)
+  (* merge new and old *)
+  let ht = Hashtbl.create 0xff in
+  let () =
+    List.iter
+      (fun (_section_name, keys) ->
+        List.iter (fun k -> Hashtbl.replace ht k ()) keys)
+      t.denoms
+  in
+  let () = List.iter (List.iter (fun k -> Hashtbl.replace ht k ())) news in
+  let all = List.of_seq @@ Hashtbl.to_seq_keys ht in
+  let denoms =
+    List.map
+      (fun section_name ->
+        let keys = List.filter (fun k -> k.section_name = section_name) all in
+        (section_name, keys))
+      sections
+  in
+
+  { t with denoms }
 
 (* --- *)
 
@@ -174,11 +213,18 @@ let t =
   | Ok t -> t
 
 let sm_key_pub = t.sm_key_pub
-let keys () = List.map (fun { priv= _; pub; t1; t2 } -> (pub, t1, t2)) t.keys
+let all_keys () = List.map snd t.denoms |> List.concat
+
+let keys () =
+  all_keys ()
+  |> List.map (fun { section_name; priv= _; pub; t1; t2 } ->
+      (section_name, pub, t1, t2))
+
 let sign_with_sm_key s = EddsaSignature.sign ~key:t.sm_key_priv s
 
 let find_key pub =
-  List.find_opt (fun k -> k.pub = pub) t.keys
+  all_keys ()
+  |> List.find_opt (fun k -> k.pub = pub)
   |> Option.to_result ~none:"key not found"
 
 let sign ~pub s =
@@ -186,14 +232,4 @@ let sign ~pub s =
   let data = RsaSignature.sign ~key:k.priv s in
   data
 
-let delete_key pub =
+(* TODO add delete functions *)
-  let* k = find_key pub in
-  let l = List.filter (fun k -> k.pub <> pub) t.keys in
-  t.keys <- l;
-  delete_key_file k
-
-let delete_outdated ~now =
-  t.keys
-  |> List.filter (fun k -> Absolute.compare now k.t2 >= 0)
-  |> List.map (fun k -> k.pub)
-  |> list_iter delete_key