secrets.old/sk_0

@@ -0,0 +1 @@
+ÙÊÙK^¿®Ê£ÕSaÊ<61>;ߟԴcîªpð%¢¶D 

secrets.old/sm_key

@@ -0,0 +1 @@
+ðŒ½vö5&øê4­r¹}µµA !È6ošCRGt¦s

src/config.ml

@@ -2,6 +2,7 @@ open Parse_config
 
 let config_filename = "mte.conf"
 let secrets_dir = Fpath.v "secrets"
+let secmod_dir = Fpath.(secrets_dir / "secmod")
 
 let config_data =
   match Assets_crunch.read config_filename with

src/data_file.ml

@@ -2,34 +2,20 @@ open Bos.OS
 open Syntax
 open Crypto
 
-let read fname =
-  let* b = File.exists fname |> Syntax.unwrap_err_msg in
-  match b with
-  | false -> Ok None
-  | true ->
-      let+ content = File.read fname |> Syntax.unwrap_err_msg in
-      Some content
+let read fname = File.read fname |> unwrap_err_msg
 
 let write_eddsa fname priv =
-  EddsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg
+  EddsaPrivateKey.to_octets priv |> File.write fname |> unwrap_err_msg
 
 let write_rsa fname priv =
-  RsaPrivateKey.to_octets priv |> File.write fname |> Syntax.unwrap_err_msg
+  RsaPrivateKey.to_octets priv |> File.write fname |> unwrap_err_msg
 
 let read_eddsa fname =
-  let* opt = read fname in
-  match opt with
-  | None -> Ok None
-  | Some data -> (
-      EddsaPrivateKey.of_octets data |> function
-      | Error e -> Error e
-      | Ok v -> Ok (Some v))
+  let* data = read fname in
+  let+ v = EddsaPrivateKey.of_octets data in
+  v
 
 let read_rsa fname =
-  let* opt = read fname in
-  match opt with
-  | None -> Ok None
-  | Some data -> (
-      RsaPrivateKey.of_octets data |> function
-      | Error e -> Error e
-      | Ok v -> Ok (Some v))
+  let* data = read fname in
+  let+ v = RsaPrivateKey.of_octets data in
+  v

src/http_management.ml

@@ -32,15 +32,15 @@ module Keys_get = struct
 end
 
 module Keys_post = struct
+  let error_key_unknown =
+    "404 not found, One of the keys for which a signature was provided is \
+     unknown to the exchange."
+
   let verify_denom_signature (module Sm : Secmod.S)
       DenomSignature.{ h_denom_pub; master_sig } =
     let* denom =
-      match Sm.find_denomination h_denom_pub with
-      | None ->
-          Fmt.error
-            "404 not found, One of the keys for which a signature was provided \
-             is unknown to the exchange."
-      | Some denom -> Ok denom
+      Sm.find_future_denomination h_denom_pub
+      |> Option.to_result ~none:error_key_unknown
     in
     let open Signatures.DenominationKeyValidity in
     let r : r =
@@ -63,12 +63,7 @@ module Keys_post = struct
   let verify_signkey_signature (module Sm : Secmod.S)
       SignKeySignature.{ key; master_sig } =
     let* signkey =
-      match Sm.find_signkey key with
-      | None ->
-          Fmt.error
-            "404 not found, One of the keys for which a signature was provided \
-             is unknown to the exchange."
-      | Some signkey -> Ok signkey
+      Sm.find_future_signkey key |> Option.to_result ~none:error_key_unknown
     in
     let open Signatures.ExchangeSigningKeyValidity in
     let r : r =
@@ -76,7 +71,7 @@ module Keys_post = struct
         start= signkey.stamp_start;
         expire= signkey.stamp_expire;
         end_= signkey.stamp_end;
-        signkey_pub= signkey.pub;
+        signkey_pub= signkey.key;
       }
     in
     verify_f ~f:Sm.verify_with_master_key master_sig r

src/secmod.ml

@@ -16,6 +16,8 @@ module type S = sig
   val get_future_denominations : unit -> Api.FutureDenom.t list
   val find_signkey : eddsa_pub -> Signkey.t option
   val find_denomination : denom_hash -> Denomination.t option
+  val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option
+  val find_future_denomination : denom_hash -> Api.FutureDenom.t option
 
   val certify_future_signkey :
     eddsa_pub ->
@@ -64,11 +66,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 +88,70 @@ 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 () =
     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
 
@@ -284,16 +267,29 @@ 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 "secmod: 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, generating fresh keys");
         let t = make_new () in
-        Logs.info (fun m -> m "secmod initialized with fresh keys");
+        Ok t
+    | false ->
+        Logs.info (fun m -> m "secmod: loading keys from storage");
+        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
@@ -324,7 +320,9 @@ module Make (Conn : Pg.CONN) = struct
     t.future_dn_ht |> Hashtbl.to_seq_values |> List.of_seq
 
   let find_signkey pub = Hashtbl.find_opt t.sk_ht pub
-  let find_denomination pub = Hashtbl.find_opt t.dn_ht pub
+  let find_denomination h_pub = Hashtbl.find_opt t.dn_ht h_pub
+  let find_future_signkey pub = Hashtbl.find_opt t.future_sk_ht pub
+  let find_future_denomination h_pub = Hashtbl.find_opt t.future_dn_ht h_pub
 
   let certify_future_signkey pub master_sig =
     match
@@ -453,7 +451,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 +463,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 ()

src/secmod.mli

@@ -16,6 +16,8 @@ module type S = sig
   val get_future_denominations : unit -> Api.FutureDenom.t list
   val find_signkey : eddsa_pub -> Signkey.t option
   val find_denomination : denom_hash -> Denomination.t option
+  val find_future_signkey : eddsa_pub -> Api.FutureSignKey.t option
+  val find_future_denomination : denom_hash -> Api.FutureDenom.t option
 
   val certify_future_signkey :
     eddsa_pub ->