wip lock

src/database.ml

@@ -27,7 +27,7 @@ let dummy_master_sig =
 let test_activate req server _ =
   let db_conn = Vif.Server.device Devices.db_connection server in
   let secmod_signkey = Vif.Server.device Devices.secmod_signkey server in
-  let sm_key = secmod_signkey.sm_key in
+  let sm_key = Secmod_signkey.get_sm_key secmod_signkey in
   let sm_key = { sm_key with master_sig= dummy_master_sig } in
   let res = Pg.activate_signing_key db_conn sm_key in
   Result.fold ~ok:(on_ok req) ~error:(on_error req) res

src/devices.ml

@@ -22,29 +22,9 @@ let secmod_signkey =
   let finally _key = () in
   Vif.Device.v ~name:"secmod_signkey" ~finally
     [ Vif.Device.value db_connection ]
-  @@ fun conn (_env : env) ->
+  @@ fun conn (_env : env) -> Secmod_signkey.init conn
-  match Secmod_signkey.load conn with
-  | Ok None ->
-      let t = Secmod_signkey.make_new () in
-      Logs.info (fun m -> m "secmod_signkey initialized with fresh keys");
-      t
-  | Ok (Some v) ->
-      Logs.info (fun m -> m "secmod_signkey initialized from storage");
-      v
-  | Error _ ->
-      (* TODO error: pretty print *)
-      Fmt.failwith "secmod_signkey init failure."
 
 let secmod_denom =
   let finally _key = () in
   Vif.Device.v ~name:"secmod_denom" ~finally [ Vif.Device.value db_connection ]
-  @@ fun conn (_env : env) ->
+  @@ fun conn (_env : env) -> Secmod_denom.init conn
-  match Secmod_denom.load conn with
-  | Ok None ->
-      let t = Secmod_denom.make_new () in
-      Logs.info (fun m -> m "secmod_denom initialized with fresh keys");
-      t
-  | Ok (Some v) ->
-      Logs.info (fun m -> m "secmod_denom initialized from storage");
-      v
-  | Error _ -> Fmt.failwith "secmod_denom init failure."

src/management.ml

@@ -66,22 +66,25 @@ let mk_future_signkey ~sm_signkey_priv
 
 let mk_future_keys_response ~(sm_signkey : Secmod_signkey.t)
     ~(sm_denom : Secmod_denom.t) =
-  let future_denoms =
-    sm_denom.keys
-    |> List.filter (fun k -> Option.is_none k.Denomination.master_sig)
-    |> List.map (fun denom ->
-        mk_future_denom ~sm_denom_priv:sm_denom.sm_key.Signkey.priv denom)
-  in
   let future_signkeys =
-    sm_signkey.keys
+    Secmod_signkey.get_signkeys sm_signkey
     |> List.filter (fun k -> Option.is_none k.Signkey.master_sig)
     |> List.map (fun signkey ->
-        mk_future_signkey ~sm_signkey_priv:sm_signkey.sm_key.Signkey.priv
+        let sm_signkey_priv =
-          signkey)
+          (Secmod_signkey.get_sm_key sm_signkey).Signkey.priv
+        in
+        mk_future_signkey ~sm_signkey_priv signkey)
+  in
+  let future_denoms =
+    Secmod_denom.get_denoms sm_denom
+    |> List.filter (fun k -> Option.is_none k.Denomination.master_sig)
+    |> List.map (fun denom ->
+        let sm_denom_priv = (Secmod_denom.get_sm_key sm_denom).Signkey.priv in
+        mk_future_denom ~sm_denom_priv denom)
   in
   let master_pub = Config.Exchange.master_public_key in
-  let denom_secmod_public_key = sm_denom.sm_key.pub in
+  let denom_secmod_public_key = (Secmod_denom.get_sm_key sm_denom).pub in
-  let signkey_secmod_public_key = sm_signkey.sm_key.pub in
+  let signkey_secmod_public_key = (Secmod_signkey.get_sm_key sm_signkey).pub in
   FutureKeysResponse.
     {
       future_denoms;
@@ -93,7 +96,7 @@ let mk_future_keys_response ~(sm_signkey : Secmod_signkey.t)
 
 (* - ** - *)
 
-let verify_denom_signature ~sm_denom DenomSignature.{ h_denom_pub; master_sig }
+let verify_denom_signature ~sm_denoms DenomSignature.{ h_denom_pub; master_sig }
     =
   let open Syntax in
   let denom_hash =
@@ -103,7 +106,7 @@ let verify_denom_signature ~sm_denom DenomSignature.{ h_denom_pub; master_sig }
     let opt =
       List.find_opt
         (fun (denom : Denomination.t) -> denom.h_pub = denom_hash)
-        sm_denom.Secmod_denom.keys
+        sm_denoms
     in
     match opt with
     | None ->
@@ -129,13 +132,11 @@ let verify_denom_signature ~sm_denom DenomSignature.{ h_denom_pub; master_sig }
   in
   verify ~key:Config.master_public_key master_sig r
 
-let verify_signkey_signature ~sm_signkey SignKeySignature.{ key; master_sig } =
+let verify_signkey_signature ~sm_signkeys SignKeySignature.{ key; master_sig } =
   let open Syntax in
   let* signkey =
     let opt =
-      List.find_opt
+      List.find_opt (fun (signkey : Signkey.t) -> signkey.pub = key) sm_signkeys
-        (fun (signkey : Signkey.t) -> signkey.pub = key)
-        sm_signkey.Secmod_signkey.keys
     in
     match opt with
     | None ->
@@ -155,17 +156,11 @@ let verify_signkey_signature ~sm_signkey SignKeySignature.{ key; master_sig } =
   in
   verify ~key:Config.master_public_key master_sig r
 
-let verify_master_signatures ~sm_signkey ~sm_denom
+let verify_master_signatures ~sm_signkeys ~sm_denoms
     MasterSignatures.{ denom_sigs; signkey_sigs } =
   let open Syntax in
-  let* () = list_iter (verify_denom_signature ~sm_denom) denom_sigs in
+  let* () = list_iter (verify_denom_signature ~sm_denoms) denom_sigs in
-  let* () = list_iter (verify_signkey_signature ~sm_signkey) signkey_sigs in
+  let* () = list_iter (verify_signkey_signature ~sm_signkeys) signkey_sigs in
-  Ok ()
-
-(* --- *)
-
-let store_master_signatures _ =
-  (* TODO *)
   Ok ()
 
 (* --- *)
@@ -215,9 +210,11 @@ let keys_post req server _env =
           Error msg
     in
     let* () =
-      verify_master_signatures ~sm_signkey ~sm_denom master_signatures
+      let sm_denoms = Secmod_denom.get_denoms sm_denom in
+      let sm_signkeys = Secmod_signkey.get_signkeys sm_signkey in
+      verify_master_signatures ~sm_signkeys ~sm_denoms master_signatures
     in
-    let* () = store_master_signatures () in
+    (* TODO let* () = update_master_signatures () in*)
     Ok ""
   in
   respond_with_res res req

src/secmod_denom.ml

@@ -1,16 +1,29 @@
 open Syntax
 
 type t = {
+  lock: Miou.Mutex.t;
   sm_key: Signkey.t;
-  (* TODO rename *)
+  denom_ht: (Bin_type.DenominationHash.t, Denomination.t) Hashtbl.t;
-  keys: Denomination.t list;
 }
 
+let get_sm_key t = t.sm_key
+
+let get_denoms t =
+  Miou.Mutex.protect t.lock @@ fun () ->
+  Hashtbl.to_seq_values t.denom_ht |> List.of_seq
+
+(* TODO *)
+let update_denoms _conn t denoms =
+  Miou.Mutex.protect t.lock @@ fun () ->
+  List.iter
+    (fun denom -> Hashtbl.replace t.denom_ht denom.Denomination.h_pub denom)
+    denoms
+
 let dir = Fpath.(v "data" / "secmod_signkey")
 
-let store_secmod_data t =
+let _store_secmod_data t =
   let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
-  t.keys
+  get_denoms t
   |> List.mapi (fun i key ->
       let fname = Fpath.(dir / string_of_int i) in
       (fname, key.Denomination.priv))
@@ -21,7 +34,7 @@ let load conn =
     Fmt.error_msg "secmod_denom load error: invalid store state."
   in
   let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in
-  let* keys =
+  let* denoms =
     let* l =
       let open Config.Coin in
       Syntax.list_map
@@ -36,12 +49,38 @@ let load conn =
     | Error () -> error_invalid_state
     | Ok opt -> Ok opt
   in
-  match (sm_key, keys) with
+  match (sm_key, denoms) with
   | None, None -> Ok None
-  | Some sm_key, Some keys -> Ok (Some { sm_key; keys })
+  | Some sm_key, Some denoms ->
+      let lock = Miou.Mutex.create () in
+      let denom_ht =
+        denoms
+        |> List.map (fun v -> (v.Denomination.h_pub, v))
+        |> List.to_seq
+        |> Hashtbl.of_seq
+      in
+      Ok (Some { lock; sm_key; denom_ht })
   | _, _ -> error_invalid_state
 
 let make_new () =
+  let lock = Miou.Mutex.create () in
   let sm_key = Signkey.make () in
-  let keys = List.map Denomination.make Config.Coin.all_coins in
+  let denoms = List.map Denomination.make Config.Coin.all_coins in
-  { sm_key; keys }
+  let denom_ht =
+    denoms
+    |> List.map (fun v -> (v.Denomination.h_pub, v))
+    |> List.to_seq
+    |> Hashtbl.of_seq
+  in
+  { lock; sm_key; denom_ht }
+
+let init conn =
+  match load conn with
+  | Ok None ->
+      let t = make_new () in
+      Logs.info (fun m -> m "secmod_denom initialized with fresh keys");
+      t
+  | Ok (Some v) ->
+      Logs.info (fun m -> m "secmod_denom initialized from storage");
+      v
+  | Error _ -> Fmt.failwith "secmod_denom init failure."

src/secmod_denom.mli

@@ -0,0 +1,6 @@
+type t
+
+val get_sm_key : t -> Signkey.t
+val get_denoms : t -> Denomination.t list
+val update_denoms : (module Pg.CONN) -> t -> Denomination.t list -> unit
+val init : (module Pg.CONN) -> t

src/secmod_signkey.ml

@@ -1,19 +1,33 @@
 (* TODO
-     - key rotation
+   - key rotation
-     - how many signkey to use?
+   - how many signkey to use?
-       we just use 1 for now *)
+     we just use 1 for now *)
 open Syntax
 
 type t = {
+  lock: Miou.Mutex.t;
   sm_key: Signkey.t;
-  keys: Signkey.t list;
+  signkey_ht: (Crypto.EddsaPublicKey.t, Signkey.t) Hashtbl.t;
 }
 
+let get_sm_key t = t.sm_key
+
+let get_signkeys t =
+  Miou.Mutex.protect t.lock @@ fun () ->
+  Hashtbl.to_seq_values t.signkey_ht |> List.of_seq
+
+(* TODO *)
+let update_signkeys _conn t signkeys =
+  Miou.Mutex.protect t.lock @@ fun () ->
+  List.iter
+    (fun signkey -> Hashtbl.replace t.signkey_ht signkey.Signkey.pub signkey)
+    signkeys
+
 let dir = Fpath.(v "data" / "secmod_signkey")
 
-let store_secmod_data t =
+let _store_secmod_data t =
   let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
-  t.keys
+  get_signkeys t
   |> List.mapi (fun i key ->
       let fname = Fpath.(dir / string_of_int i) in
       (fname, key.Signkey.priv))
@@ -24,7 +38,7 @@ let load conn =
     Fmt.error_msg "secmod_signkey load error: invalid store state."
   in
   let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in
-  let* keys =
+  let* signkeys =
     let l = List.init 1 (fun i -> Fpath.(dir / string_of_int i)) in
     let* l =
       Syntax.list_map (fun fname -> Data_file.load_signkey conn fname) l
@@ -33,12 +47,40 @@ let load conn =
     | Error () -> error_invalid_state
     | Ok opt -> Ok opt
   in
-  match (sm_key, keys) with
+  match (sm_key, signkeys) with
   | None, None -> Ok None
-  | Some sm_key, Some keys -> Ok (Some { sm_key; keys })
+  | Some sm_key, Some signkeys ->
+      let lock = Miou.Mutex.create () in
+      let signkey_ht =
+        signkeys
+        |> List.map (fun v -> (v.Signkey.pub, v))
+        |> List.to_seq
+        |> Hashtbl.of_seq
+      in
+      Ok (Some { lock; sm_key; signkey_ht })
   | _, _ -> error_invalid_state
 
 let make_new () =
+  let lock = Miou.Mutex.create () in
   let sm_key = Signkey.make () in
-  let keys = [ Signkey.make () ] in
+  let signkeys = [ Signkey.make () ] in
-  { sm_key; keys }
+  let signkey_ht =
+    signkeys
+    |> List.map (fun v -> (v.Signkey.pub, v))
+    |> List.to_seq
+    |> Hashtbl.of_seq
+  in
+  { lock; sm_key; signkey_ht }
+
+let init conn =
+  match load conn with
+  | Ok None ->
+      let t = make_new () in
+      Logs.info (fun m -> m "secmod_signkey initialized with fresh keys");
+      t
+  | Ok (Some v) ->
+      Logs.info (fun m -> m "secmod_signkey initialized from storage");
+      v
+  | Error _ ->
+      (* TODO error: pretty print *)
+      Fmt.failwith "secmod_signkey init failure."

src/secmod_signkey.mli

@@ -0,0 +1,6 @@
+type t
+
+val get_sm_key : t -> Signkey.t
+val get_signkeys : t -> Signkey.t list
+val update_signkeys : (module Pg.CONN) -> t -> Signkey.t list -> unit
+val init : (module Pg.CONN) -> t