add secmod_denom.ml secmod_signkey.ml

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."