src/secmod.ml

@@ -64,11 +64,12 @@ module Make (Conn : Pg.CONN) = struct
     dn_section_name_ht: (denom_hash, string) Hashtbl.t;
   }
 
-  let sm_key_fname = Fpath.(Config.secrets_dir / "sm_key")
-  let sk_key_fname i = Fpath.(Config.secrets_dir / Fmt.str "sk_%d" i)
+  let conn = (module Conn : Pg.CONN)
+  let sm_key_fname = Fpath.(Config.secmod_dir / "sm_key")
+  let sk_fname i = Fpath.(Config.secmod_dir / Fmt.str "sk_%d" i)
 
-  let dn_key_fname section_name =
-    Fpath.(Config.secrets_dir / Fmt.str "dn_%s" section_name)
+  let dn_fname section_name =
+    Fpath.(Config.secmod_dir / Fmt.str "dn_%s" section_name)
 
   let database_find_sk conn pub =
     let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in
@@ -85,90 +86,71 @@ module Make (Conn : Pg.CONN) = struct
           "secmod failure: a denomination could not be found in database"
     | Some dn_data -> Ok dn_data
 
-  (* TODO clean up *)
-  let load conn =
-    let error_invalid_state =
-      Fmt.error "secmod load error: invalid store state."
-    in
+  let list_to_ht l = Hashtbl.of_seq (List.to_seq l)
+
+  let load () =
+    Logs.info (fun m -> m "secmod: loading keys data from storage");
     let* sm_key = Data_file.read_eddsa sm_key_fname in
-    let* sk_keys =
-      let l = List.init 1 sk_key_fname in
-      let* l = list_map (fun fname -> Data_file.read_eddsa fname) l in
-      match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt
+    let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in
+
+    let* sk_keys = list_map Data_file.read_eddsa (List.init 1 sk_fname) in
+    let* sk_l =
+      list_map
+        (fun priv ->
+          let pub = EddsaPrivateKey.pub_of_priv priv in
+          let+ sk = database_find_sk conn pub in
+          ((pub, sk), (pub, priv)))
+        sk_keys
     in
+    let sk_ht, sk_key_ht =
+      match List.split sk_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
+    in
+
+    let dn_section_name_ht = Hashtbl.create 0xff in
     let* dn_keys =
-      let* l =
-        let open Config.Coin in
-        list_map
-          (fun coin ->
-            let section_name = coin.section_name in
-            let+ opt = Data_file.read_rsa (dn_key_fname section_name) in
-            Option.map (fun priv -> (section_name, priv)) opt)
-          all_coins
-      in
-      match Syntax.opt_list l with
-      | Error () -> error_invalid_state
-      | Ok opt -> Ok opt
+      list_map
+        (fun coin ->
+          let section_name = coin.Config.Coin.section_name in
+          let+ priv = Data_file.read_rsa (dn_fname section_name) in
+          (section_name, priv))
+        Config.Coin.all_coins
     in
-    match (sm_key, sk_keys, dn_keys) with
-    | None, None, None -> Ok None
-    | Some sm_key, Some sk_keys, Some dn_keys ->
-        let list_to_ht l = Hashtbl.of_seq (List.to_seq l) in
-        let sm_pubkey = EddsaPrivateKey.pub_of_priv sm_key in
-        (* sk *)
-        let* l =
-          list_map
-            (fun priv ->
-              let pub = EddsaPrivateKey.pub_of_priv priv in
-              let+ sk = database_find_sk conn pub in
-              ((pub, sk), (pub, priv)))
-            sk_keys
-        in
-        let sk_ht, sk_key_ht =
-          let sk_l, priv_l = List.split l in
-          (list_to_ht sk_l, list_to_ht priv_l)
-        in
-        (* dn *)
-        let dn_section_name_ht = Hashtbl.create 0xff in
-        let* l =
-          list_map
-            (fun (section_name, priv) ->
-              let h_pub =
-                priv
-                |> RsaPrivateKey.pub_of_priv
-                |> RsaPublicKey.to_octets
-                |> DenominationHash.hash
-              in
-
-              (* fill dn_section_name_ht *)
-              Hashtbl.replace dn_section_name_ht h_pub section_name;
-
-              let+ dn = database_find_dn conn h_pub in
-              ((h_pub, dn), (h_pub, priv)))
-            dn_keys
-        in
-        let dn_ht, dn_key_ht =
-          match List.split l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
-        in
-        (* future keys are not stored anywhere until they are certified with a master_sig
-           so we don't have any future key to load *)
-        let t =
-          {
-            sm_key;
-            sm_pubkey;
-            sk_ht;
-            dn_ht;
-            sk_key_ht;
-            dn_key_ht;
-            future_sk_ht= Hashtbl.create 0xff;
-            future_dn_ht= Hashtbl.create 0xff;
-            future_sk_key_ht= Hashtbl.create 0xff;
-            future_dn_key_ht= Hashtbl.create 0xff;
-            dn_section_name_ht;
-          }
-        in
-        Ok (Some t)
-    | _, _, _ -> error_invalid_state
+    let* dn_l =
+      list_map
+        (fun (section_name, priv) ->
+          let h_pub =
+            priv
+            |> RsaPrivateKey.pub_of_priv
+            |> RsaPublicKey.to_octets
+            |> DenominationHash.hash
+          in
+          (* fill dn_section_name_ht *)
+          Hashtbl.replace dn_section_name_ht h_pub section_name;
+          let+ dn = database_find_dn conn h_pub in
+          ((h_pub, dn), (h_pub, priv)))
+        dn_keys
+    in
+    let dn_ht, dn_key_ht =
+      match List.split dn_l with l1, l2 -> (list_to_ht l1, list_to_ht l2)
+    in
+    (* future keys are not stored anywhere until they are certified with a master_sig
+       so we don't have any future key to load *)
+    let t =
+      {
+        sm_key;
+        sm_pubkey;
+        sk_ht;
+        dn_ht;
+        sk_key_ht;
+        dn_key_ht;
+        future_sk_ht= Hashtbl.create 0xff;
+        future_dn_ht= Hashtbl.create 0xff;
+        future_sk_key_ht= Hashtbl.create 0xff;
+        future_dn_key_ht= Hashtbl.create 0xff;
+        dn_section_name_ht;
+      }
+    in
+    Ok t
 
   let sign_with_sm_key t s = EddsaSignature.sign ~key:t.sm_key s
 
@@ -264,6 +246,7 @@ module Make (Conn : Pg.CONN) = struct
     ()
 
   let make_new () =
+    Logs.info (fun m -> m "secmod: generating fresh keys");
     let sm_key, sm_pubkey = Mirage_crypto_ec.Ed25519.generate () in
     let t =
       {
@@ -284,16 +267,26 @@ module Make (Conn : Pg.CONN) = struct
     List.iter (make_future_dn t) Config.Coin.all_coins;
     t
 
-  let t =
-    match load (module Conn) with
-    | Ok None ->
+  let init () =
+    let dir = Config.secmod_dir in
+    let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in
+    if b then Logs.info (fun m -> m "created directory `%a`" Fpath.pp dir);
+    let* l =
+      Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg
+    in
+    match List.is_empty l with
+    | true ->
+        Logs.info (fun m -> m "secmod: empty storage");
         let t = make_new () in
-        Logs.info (fun m -> m "secmod initialized with fresh keys");
+        Ok t
+    | false -> load ()
+
+  let t =
+    match init () with
+    | Error e -> Fmt.failwith "secmod initialization failure: `%s`." e
+    | Ok t ->
+        Logs.info (fun m -> m "secmod initialized");
         t
-    | Ok (Some t) ->
-        Logs.info (fun m -> m "secmod initialized from storage");
-        t
-    | Error e -> Fmt.failwith "secmod init failure: %s." e
 
   let sm_pubkey = t.sm_pubkey
   let sign_with_sm_key s = sign_with_sm_key t s
@@ -453,7 +446,7 @@ module Make (Conn : Pg.CONN) = struct
     let* () =
       Hashtbl.to_seq_values t.sk_key_ht
       |> List.of_seq
-      |> List.mapi (fun i priv -> Data_file.write_eddsa (sk_key_fname i) priv)
+      |> List.mapi (fun i priv -> Data_file.write_eddsa (sk_fname i) priv)
       |> list_iter Fun.id
     in
     let* () =
@@ -465,7 +458,7 @@ module Make (Conn : Pg.CONN) = struct
             | None -> Error "invalid state, section_name not found"
             | Some s -> Ok s
           in
-          Data_file.write_rsa (dn_key_fname section_name) priv)
+          Data_file.write_rsa (dn_fname section_name) priv)
     in
     Logs.info (fun m -> m "saved secmod private keys data");
     Ok ()