src/devices.ml

@@ -1,5 +1,3 @@
-open Syntax
-
 type env = {
   caqti_switch: Caqti_miou.Switch.t;
   db_uri: Uri.t;
@@ -20,130 +18,33 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
           Logs.info (fun m -> m "database connection initialized");
           conn)
 
-module Secmod_signkey = struct
-  (* TODO
-     - key rotation
-     - how many signkey to use?
-       we just use 1 for now *)
-  type t = {
-    sm_key: Signkey.t;
-    keys: Signkey.t list;
-  }
+let secmod_signkey =
+  let finally _key = () in
+  Vif.Device.v ~name:"secmod_signkey" ~finally
+    [ Vif.Device.value db_connection ]
+  @@ fun conn (_env : env) ->
+  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 dir = Fpath.(v "data" / "secmod_signkey")
-
-  let store_secmod_data t =
-    let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
-    t.keys
-    |> List.mapi (fun i key ->
-        let fname = Fpath.(dir / string_of_int i) in
-        (fname, key.Signkey.priv))
-    |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
-
-  let load conn =
-    let error_invalid_state =
-      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 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
-      in
-      match Syntax.opt_list l with
-      | Error () -> error_invalid_state
-      | Ok opt -> Ok opt
-    in
-    match (sm_key, keys) with
-    | None, None -> Ok None
-    | Some sm_key, Some keys -> Ok (Some { sm_key; keys })
-    | _, _ -> error_invalid_state
-
-  let generate_fresh_secmod_data () =
-    let sm_key = Signkey.generate () in
-    let keys = [ Signkey.generate () ] in
-    { sm_key; keys }
-
-  let v =
-    let finally _key = () in
-    Vif.Device.v ~name:"secmod_signkey" ~finally
-      [ Vif.Device.value db_connection ]
-    @@ fun conn (_env : env) ->
-    match load conn with
-    | Ok None ->
-        let t = generate_fresh_secmod_data () 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."
-end
-
-module Secmod_denom = struct
-  type t = {
-    sm_key: Signkey.t;
-    (* TODO rename *)
-    keys: Denomination.t list;
-  }
-
-  let dir = Fpath.(v "data" / "secmod_signkey")
-
-  let store_secmod_data t =
-    let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
-    t.keys
-    |> List.mapi (fun i key ->
-        let fname = Fpath.(dir / string_of_int i) in
-        (fname, key.Denomination.priv))
-    |> list_iter (fun (fname, key) -> Data_file.write_rsa fname key)
-
-  let load conn =
-    let error_invalid_state =
-      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* l =
-        let open Config.Coin in
-        Syntax.list_map
-          (fun coin ->
-            let section_name = coin.section_name in
-            let fname = Fpath.(dir / section_name) in
-            (* todo: could check that coin config match db values *)
-            Data_file.load_denom conn ~section_name fname)
-          all_coins
-      in
-      match Syntax.opt_list l with
-      | Error () -> error_invalid_state
-      | Ok opt -> Ok opt
-    in
-    match (sm_key, keys) with
-    | None, None -> Ok None
-    | Some sm_key, Some keys -> Ok (Some { sm_key; keys })
-    | _, _ -> error_invalid_state
-
-  let generate_fresh_secmod_data () =
-    let sm_key = Signkey.generate () in
-    let keys = List.map Denomination.make Config.Coin.all_coins in
-    { sm_key; keys }
-
-  let v =
-    let finally _key = () in
-    Vif.Device.v ~name:"secmod_denom" ~finally
-      [ Vif.Device.value db_connection ]
-    @@ fun conn (_env : env) ->
-    match load conn with
-    | Ok None ->
-        let t = generate_fresh_secmod_data () 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."
-end
-
-let secmod_signkey = Secmod_signkey.v
-let secmod_denom = Secmod_denom.v
+let secmod_denom =
+  let finally _key = () in
+  Vif.Device.v ~name:"secmod_denom" ~finally [ Vif.Device.value db_connection ]
+  @@ fun conn (_env : env) ->
+  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

@@ -1,5 +1,4 @@
 open Api
-open Devices
 
 let mk_future_denom ~sm_denom_priv
     ({

src/secmod_denom.ml

@@ -0,0 +1,47 @@
+open Syntax
+
+type t = {
+  sm_key: Signkey.t;
+  (* TODO rename *)
+  keys: Denomination.t list;
+}
+
+let dir = Fpath.(v "data" / "secmod_signkey")
+
+let store_secmod_data t =
+  let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
+  t.keys
+  |> List.mapi (fun i key ->
+      let fname = Fpath.(dir / string_of_int i) in
+      (fname, key.Denomination.priv))
+  |> list_iter (fun (fname, key) -> Data_file.write_rsa fname key)
+
+let load conn =
+  let error_invalid_state =
+    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* l =
+      let open Config.Coin in
+      Syntax.list_map
+        (fun coin ->
+          let section_name = coin.section_name in
+          let fname = Fpath.(dir / section_name) in
+          (* todo: could check that coin config match db values *)
+          Data_file.load_denom conn ~section_name fname)
+        all_coins
+    in
+    match Syntax.opt_list l with
+    | Error () -> error_invalid_state
+    | Ok opt -> Ok opt
+  in
+  match (sm_key, keys) with
+  | None, None -> Ok None
+  | Some sm_key, Some keys -> Ok (Some { sm_key; keys })
+  | _, _ -> error_invalid_state
+
+let make_new () =
+  let sm_key = Signkey.make () in
+  let keys = List.map Denomination.make Config.Coin.all_coins in
+  { sm_key; keys }

src/secmod_signkey.ml

@@ -0,0 +1,44 @@
+(* TODO
+     - key rotation
+     - how many signkey to use?
+       we just use 1 for now *)
+open Syntax
+
+type t = {
+  sm_key: Signkey.t;
+  keys: Signkey.t list;
+}
+
+let dir = Fpath.(v "data" / "secmod_signkey")
+
+let store_secmod_data t =
+  let* () = Data_file.write_eddsa Fpath.(dir / "sm_key") t.sm_key.priv in
+  t.keys
+  |> List.mapi (fun i key ->
+      let fname = Fpath.(dir / string_of_int i) in
+      (fname, key.Signkey.priv))
+  |> list_iter (fun (fname, key) -> Data_file.write_eddsa fname key)
+
+let load conn =
+  let error_invalid_state =
+    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 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
+    in
+    match Syntax.opt_list l with
+    | Error () -> error_invalid_state
+    | Ok opt -> Ok opt
+  in
+  match (sm_key, keys) with
+  | None, None -> Ok None
+  | Some sm_key, Some keys -> Ok (Some { sm_key; keys })
+  | _, _ -> error_invalid_state
+
+let make_new () =
+  let sm_key = Signkey.make () in
+  let keys = [ Signkey.make () ] in
+  { sm_key; keys }

src/signkey.ml

@@ -12,18 +12,13 @@ type t = {
   master_sig: EddsaSignature.t option;
 }
 
-let generate () =
-  (* TODO
-       - look if it exists
-       - if not, create it (TOFU initialization scheme)
-       - write it *)
+let make () =
   let stamp_start = Ptime_clock.now () |> Option.some in
   let stamp_expire =
     Timestamp.add_span_exn stamp_start
       (Some Config.Exchange.signkey_legal_duration)
   in
   let stamp_end = stamp_expire in
-
   let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
   let master_sig = None in
   { pub; priv; stamp_start; stamp_expire; stamp_end; master_sig }