fix secmod add/write; + wip test revoke

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
@@ -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.
           {
@@ -187,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.
@@ -257,8 +285,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 +302,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 +315,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 +326,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
@@ -70,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
 
 (* -- *)
 
@@ -131,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
@@ -162,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
 
@@ -178,6 +180,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 +209,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
@@ -112,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
 
 (* -- *)
 
@@ -179,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
 
@@ -224,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
 
@@ -252,6 +254,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 +266,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 ();

test/offline_management.sh

@@ -22,6 +22,25 @@ offline_tool sign \
 offline_tool upload --input $b --url $url"/management/keys"
 echo "[OK] /management/keys"
 
+offline_tool download --output $a --url $url"/keys"
+rsa_pub=$(jq -r '.denominations[0].denoms[0].rsa_pub' $a)
+offline_tool revoke-denom \
+--master_key $master_key \
+--output $b \
+--rsa \
+$rsa_pub
+h_denom=$(dune exec offline -- hash64 $rsa_pub)
+offline_tool upload --input $b --url $url"/management/denominations/"$h_denom"/revoke"
+echo "[OK] /management/denominations/\$H_DENOM/revoke"
+
+pub=$(jq -r '.signkeys[0].key' $a)
+offline_tool revoke-signkey \
+--master_key $master_key \
+--output $b \
+$pub
+offline_tool upload --input $b --url $url"/management/signkeys/"$pub"/revoke"
+echo "[OK] /management/signkeys/\$EXCHANGE_PUB/revoke"
+
 offline_tool enable-auditor \
 --master_key $master_key \
 --output $b \
@@ -32,6 +51,8 @@ offline_tool enable-auditor \
 offline_tool upload --input $b --url $url"/management/auditors"
 echo "[OK] /management/auditors"
 
+# todo test disable auditor
+
 offline_tool wire-fee \
 --master_key $master_key \
 --output $b \
@@ -56,3 +77,9 @@ offline_tool global-fees \
 --purse_timeout 9999999
 offline_tool upload --input $b --url $url"/management/global-fees"
 echo "[OK] /management/global-fees"
+
+# todo test enable wire
+# todo test disable wire
+# todo test drain
+# todo test aml-officer
+# todo test partners

tools/offline.ml

@@ -128,14 +128,54 @@ let sign_cmd =
 
 let revoke_denom_cmd =
   let doc = "Revoke denomination." in
-  let h_denom =
+  let is_rsa_pub =
-    let doc = "hash of denomination public key" in
+    let doc =
+      "interpret input string as a RSA public key (in Crockford-base32) \
+       instead of a denomination hash"
+    in
+    Arg.(value & flag & info [ "rsa" ] ~doc)
+  in
+  let v =
+    let doc = "hash of denomination (or RSA public key if --rsa is set)" in
     Arg.(required & pos 0 (some string) None & info [] ~doc)
   in
   Cmd.make (Cmd.info "revoke-denom" ~doc)
   @@
-  let+ output = output and+ master_key = master_key and+ h_denom = h_denom in
+  let+ output = output
-  revoke_denom ~output ~master_key ~h_denom
+  and+ master_key = master_key
+  and+ is_rsa_pub = is_rsa_pub
+  and+ v = v in
+  let res =
+    match is_rsa_pub with
+    | false -> Ok v
+    | true -> (
+        match B32.decode v with
+        | Error e -> Error e
+        | Ok s ->
+            let h = Hash.DenominationHash.hash s in
+            let s = B32.encode (Hash.DenominationHash.to_octets h) in
+            Ok s)
+  in
+  match res with
+  | Error e -> Error e
+  | Ok h_denom -> revoke_denom ~output ~master_key ~h_denom
+
+(* just for tests... *)
+let test_hash64_cmd =
+  let doc =
+    "Compute SHA-512, print output to stdout, input and output are \
+     Crockford-base32 encoded"
+  in
+  let s = Arg.(required & pos 0 (some string) None & info []) in
+  Cmd.make (Cmd.info "hash64" ~doc)
+  @@
+  let+ s = s in
+  match B32.decode s with
+  | Error e -> Error e
+  | Ok s ->
+      let h = Hash.DenominationHash.hash s in
+      let s = B32.encode (Hash.DenominationHash.to_octets h) in
+      Fmt.pr "%s@." s; Ok ()
 
 let revoke_signkey_cmd =
   let doc = "Revoke signkey." in
@@ -305,6 +345,7 @@ let cli =
       wire_fee_cmd;
       global_fees_cmd;
       drain_cmd;
+      test_hash64_cmd;
     ]
 
 let main () = Cmd.eval_result cli