fix secmod add

src/keys.ml

@@ -68,6 +68,7 @@ module Make (Conn : Pg.CONN) : S = struct
             m
               "some signkeys found in database are missing from secmod, \
                (unclean database/secmod state?)");
+        Logs.debug (fun m -> m "found %d active signkey(s)" (List.length l));
         l
 
   let denominations () =
@@ -84,9 +85,12 @@ module Make (Conn : Pg.CONN) : S = struct
             m
               "some denominations found in database are missing from secmod, \
                (unclean database/secmod state?)");
+        Logs.debug (fun m ->
+            m "found %d active denomination(s)" (List.length l));
         l
 
   let make_future_sk (pub, (start, expire)) =
+    Logs.debug (fun m -> m "make_future_sk: `%s`" (EddsaPublicKey.to_b32 pub));
     let open Time in
     let stamp_start = Timestamp.of_absolute start in
     let stamp_expire = Timestamp.of_absolute expire in
@@ -113,6 +117,9 @@ module Make (Conn : Pg.CONN) : S = struct
     | Some v -> v
 
   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));
     let open Time in
     let Config.Coin.
           {
@@ -257,8 +264,10 @@ module Make (Conn : Pg.CONN) : S = struct
             (* rebuild it *)
             let future_sk = make_future_sk (pub, (t1, t2)) in
             let sk = sk_of_future_sk future_sk master_sig in
-            let* () = Pg.insert_signkey conn sk |> unwrap_err_caqti in
+            let+ () = Pg.insert_signkey conn sk |> unwrap_err_caqti in
-            Ok ())
+            Logs.info (fun m ->
+                m "certified signkey `%s`" (EddsaPublicKey.to_b32 sk.pub));
+            ())
 
   let certify_future_denomination h_pub master_sig =
     match Sm_rsa.find_key h_pub with
@@ -272,8 +281,11 @@ module Make (Conn : Pg.CONN) : S = struct
         | None ->
             let future_dn = make_future_dn (h_pub, (section_name, pub, t1)) in
             let dn = dn_of_future_dn future_dn h_pub master_sig in
-            let* () = Pg.insert_denom conn dn |> unwrap_err_caqti in
+            let+ () = Pg.insert_denom conn dn |> unwrap_err_caqti in
-            Ok ())
+            Logs.info (fun m ->
+                m "certified denomination `%s`"
+                  (B32.encode @@ Hash.DenominationHash.to_octets dn.h_pub));
+            ())
 
   let revoke_signkey pub revoked_sig =
     let* opt = find_signkey pub in
@@ -282,6 +294,7 @@ module Make (Conn : Pg.CONN) : S = struct
     let+ () =
       Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti
     in
+    Logs.info (fun m -> m "revoked signkey `%s`" (EddsaPublicKey.to_b32 pub));
     ()
 
   let revoke_denomination h_pub revoked_sig =
@@ -292,5 +305,8 @@ module Make (Conn : Pg.CONN) : S = struct
       Pg.insert_denomination_revocation conn dn.h_pub revoked_sig
       |> unwrap_err_caqti
     in
+    Logs.info (fun m ->
+        m "revoked denomination `%s`"
+          (B32.encode @@ Hash.DenominationHash.to_octets h_pub));
     ()
 end

src/secmod_eddsa.ml

@@ -57,11 +57,17 @@ let write_eddsa fpath priv =
 let write_key k = write_eddsa (key_fpath k) k.priv
 
 let delete_file fpath =
-  Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
+  (* check fpath just to be safe *)
-  (* TODO just to be safe~~
+  let () =
+    let root = Fpath.v Cfg.key_dir in
+    if not @@ Fpath.is_rooted ~root fpath then
+      Fmt.failwith
+        "delete_file failure: file `%a` is not contained in secmod directory"
+        Fpath.pp fpath
+  in
+  Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath);
   let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
-*)
+  ()
-  Ok ()
 
 let get_key_dir_contents dir =
   let* dir = Fpath.of_string dir |> unwrap_err_msg in
@@ -178,6 +184,7 @@ module Make () = struct
   let add t1 t2 =
     let k = gen_key t1 t2 in
     Hashtbl.replace t.ht k.pub k;
+    let+ () = write_key k in
     ()
 
   let delete pub =
@@ -206,7 +213,8 @@ module Make () = struct
   let revoke pub =
     let* k = find pub in
     let* () = delete pub in
-    add k.t1 k.t2; Ok ()
+    let* () = add k.t1 k.t2 in
+    Ok ()
 
   let conv = fun { priv= _; pub; t1; t2 } -> (pub, (t1, t2))
   let keys () = Hashtbl.to_seq_values t.ht |> List.of_seq |> List.map conv

src/secmod_rsa.ml

@@ -100,11 +100,17 @@ let write_rsa fpath priv =
 let write_key k = write_rsa (key_fpath k) k.priv
 
 let delete_file fpath =
-  Log.debug (fun m -> m "(disabled) delete key file `%a`" Fpath.pp fpath);
+  (* check fpath just to be safe *)
-  (* TODO just to be safe~~
+  let () =
+    let root = Fpath.v Cfg.key_dir in
+    if not @@ Fpath.is_rooted ~root fpath then
+      Fmt.failwith
+        "delete_file failure: file `%a` is not contained in secmod directory"
+        Fpath.pp fpath
+  in
+  Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath);
   let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in
-*)
+  ()
-  Ok ()
 
 let get_key_dir_contents dir_fpath =
   let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in
@@ -252,6 +258,7 @@ module Make () = struct
   let add section_name t1 t2 =
     let k = gen_key ~section_name t1 t2 in
     Hashtbl.replace t.ht k.h_pub k;
+    let+ () = write_key k in
     ()
 
   let sm_pub = t.sm_pub
@@ -263,9 +270,11 @@ module Make () = struct
     data
 
   let revoke h_pub =
+    Log.debug (fun m ->
+        m "revoke `%s`" (DenominationHash.to_octets h_pub |> B32.encode));
     let* k = find h_pub in
     let* () = delete h_pub in
-    add k.section_name k.t1 k.t2;
+    let* () = add k.section_name k.t1 k.t2 in
     Ok ()
 
   let conv =

src/util.ml

@@ -48,8 +48,13 @@ module Log_reporter = struct
     in
     { report }
 
+  let set_level_secmods lvl =
+    let secmod_srcs = [ Secmod_rsa.src; Secmod_eddsa.src ] in
+    List.iter (fun src -> Logs.Src.set_level src lvl) secmod_srcs;
+    ()
+
   let setup () =
-    (*Logs.Src.set_level Secmod_rsa.src (Some Logs.Debug);*)
+    (*set_level_secmods (Some Logs.Debug);*)
     let level = Some Logs.Info in
     Logs.set_level ~all:false level;
     Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();