init

src/devices.ml

@@ -0,0 +1,148 @@
+open Syntax
+
+type env = {
+  caqti_switch: Caqti_miou.Switch.t;
+  db_uri: Uri.t;
+}
+
+let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
+  let finally (module Conn : Caqti_miou.CONNECTION) = Conn.disconnect () in
+  Vif.Device.v ~name:"db_connection" ~finally []
+  @@ fun { caqti_switch; db_uri } ->
+  match Caqti_miou_unix.connect ~sw:caqti_switch db_uri with
+  | Error err ->
+      Fmt.failwith "Database connection failure: %a." Caqti_error.pp err
+  | Ok conn -> (
+      match Pg.preflight conn with
+      | Error err ->
+          Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
+      | Ok () ->
+          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 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;
+    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