src/http_management.ml

@@ -9,7 +9,7 @@ module Keys_get = struct
     Logs.info (fun m -> m "GET /management/keys/");
     let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in
     let res =
-      let v = Keys.make_future_keys_response () in
+      let* v = Keys.make_future_keys_response () in
       Api.encode jsont v
     in
     Respond.result res req

src/keys.ml

@@ -13,7 +13,7 @@ module type S = sig
   val denominations : unit -> Denomination.t list result
   val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t result
   val find_future_denomination : denom_hash -> Api.FutureDenom.t result
-  val make_future_keys_response : unit -> Api.FutureKeysResponse.t
+  val make_future_keys_response : unit -> Api.FutureKeysResponse.t result
 
   val certify_future_signkey :
     eddsa_pub -> Signatures.ExchangeSigningKeyValidity.t -> unit result
@@ -194,16 +194,37 @@ module Make (Conn : Pg.CONN) : S = struct
         Ok future_dn
 
   let make_future_keys_response () =
-    let future_signkeys = Sm_eddsa.keys () |> List.map make_future_sk in
+    let now = Timestamp.of_ptime @@ Ptime_clock.now () in
-    let future_denoms = Sm_rsa.keys () |> List.map make_future_dn in
+    (* get keys from database to filter out keys already certified *)
-    Api.FutureKeysResponse.
+    let* sk_db_l = Pg.get_signkeys conn ~now |> unwrap_err_caqti in
-      {
+    let sk_ht = Hashtbl.create 0xff in
-        future_denoms;
+    List.iter (fun sk -> Hashtbl.replace sk_ht sk.Signkey.pub ()) sk_db_l;
-        future_signkeys;
+    let future_signkeys =
-        master_pub= Config.Exchange.master_public_key;
+      Sm_eddsa.keys ()
-        denom_secmod_public_key= Sm_rsa.sm_pub;
+      |> List.filter (fun (pub, _) -> not @@ Hashtbl.mem sk_ht pub)
-        signkey_secmod_public_key= Sm_eddsa.sm_pub;
+      |> List.map make_future_sk
-      }
+    in
+    let* dn_db_l = Pg.get_denominations conn () |> unwrap_err_caqti in
+    let dn_ht = Hashtbl.create 0xff in
+    List.iter (fun dn -> Hashtbl.replace dn_ht dn.Denomination.h_pub ()) dn_db_l;
+    let future_denoms =
+      Sm_rsa.keys ()
+      |> List.filter (fun (h_pub, _) -> not @@ Hashtbl.mem dn_ht h_pub)
+      |> List.map make_future_dn
+    in
+    Logs.info (fun m ->
+        m "%d future signkey(s) and %d future denomination(s) to certify"
+          (List.length future_signkeys)
+          (List.length future_denoms));
+    Ok
+      Api.FutureKeysResponse.
+        {
+          future_denoms;
+          future_signkeys;
+          master_pub= Config.Exchange.master_public_key;
+          denom_secmod_public_key= Sm_rsa.sm_pub;
+          signkey_secmod_public_key= Sm_eddsa.sm_pub;
+        }
 
   let sk_of_future_sk future_sk master_sig =
     let Api.FutureSignKey.

src/secmod_eddsa.ml

@@ -76,7 +76,7 @@ let get_key_dir_contents dir =
   let+ l =
     Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
   in
-  l
+  List.map Fpath.normalize l
 
 (* -- *)
 
@@ -137,11 +137,7 @@ let load_key fpath =
 
 let load () =
   let* l = get_key_dir_contents Cfg.key_dir in
-  let l =
+  let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in
-    l
-    |> List.map Fpath.normalize
-    |> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath)
-  in
   let* keys = list_map load_key l in
   match keys with
   | [] -> Ok None
@@ -168,7 +164,7 @@ let init () =
   let now = TimeAbsolute.of_ptime (Ptime_clock.now ()) in
   let keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
   let new_keys = gen_additional_keys_until_lookahead ~now keys in
-  let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) keys in
+  List.iter (fun k -> Hashtbl.replace t.ht k.pub k) new_keys;
   let+ () = list_iter write_key new_keys in
   t
 

src/secmod_rsa.ml

@@ -118,7 +118,7 @@ let get_key_dir_contents dir_fpath =
   let+ l =
     Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg
   in
-  l
+  List.map Fpath.normalize l
 
 (* -- *)
 
@@ -185,11 +185,7 @@ let load_key ~section_name fpath =
 let load_section section_name =
   let section_fpath = Fpath.(v Cfg.key_dir / section_name) in
   let* l = get_key_dir_contents section_fpath in
-  let l =
+  let l = List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath) l in
-    l
-    |> List.map Fpath.normalize
-    |> List.filter (fun fpath -> not @@ Fpath.equal fpath sm_key_fpath)
-  in
   let* keys = list_map (load_key ~section_name) l in
   Ok keys
 
@@ -230,7 +226,7 @@ let init () =
       Cfg.sections
   in
   let new_keys = List.concat new_keys_l in
-  let () = List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys in
+  List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys;
   let+ () = list_iter write_key new_keys in
   t