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 () -> 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 t | Ok (Some v) -> 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 t | Ok (Some v) -> v | Error _ -> Fmt.failwith "secmod_denom init failure." end let secmod_signkey = Secmod_signkey.v let secmod_denom = Secmod_denom.v