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) (* TODO KV store *) module Secmod_signkey = struct type t = { sm_key: Signkey.t; keys: Signkey.t list; } let dir = Fpath.(v "data" / "secmod_signkey") let read_eddsa_key_files fname = let open Syntax in let open Bos.OS in let open Crypto in let pub = Fpath.(dir / fname) |> Fpath.set_ext "pub" in let priv = Fpath.(dir / fname) in let* b0 = File.exists pub in let* b1 = File.exists priv in match (b0, b1) with | true, true -> let* pub = File.read pub in let* priv = File.read priv in let pub = EddsaPublicKey.of_octets pub in let priv = EddsaPrivateKey.of_octets priv in Ok (Some (pub, priv)) | false, false -> Ok None | _, _ -> Error (`Msg "secmod_signkey: invalid local file state.") let write_eddsa_key_files fname signkey = let open Syntax in let open Bos.OS in let open Crypto in let pub_file = Fpath.(dir / fname) |> Fpath.set_ext "pub" in let priv_file = Fpath.(dir / fname) in let pub = EddsaPublicKey.to_octets signkey.Signkey.pub in let priv = EddsaPrivateKey.to_octets signkey.priv in let* () = File.write pub_file pub in let* () = File.write priv_file priv in Ok () let write_local_keys t = let open Syntax in let* () = write_eddsa_key_files "eddsa_sm_key" t.sm_key in let keys = List.mapi (fun i key -> ("eddsa_" ^ string_of_int i, key)) t.keys in let* () = list_iter (fun (s, key) -> write_eddsa_key_files s key) keys in Ok () let load_local_keys conn = let open Syntax in let load s = let* opt = read_eddsa_key_files s in match opt with | None -> Ok None | Some (pub, priv) -> ( let* opt = Pg.lookup_signing_key conn pub in match opt with | None -> Fmt.error_msg "secmod_signkey error: no associtaed metadata found in \ database for key `%s`." s | Some (stamp_start, stamp_expire, stamp_end) -> let master_sig = None in Ok (Some Signkey. { pub; priv; stamp_start; stamp_expire; stamp_end; master_sig; })) in let* sm_key = load "sm_key" in let* key_0 = load "0" in match (sm_key, key_0) with | None, None -> Ok None | Some sm_key, Some key_0 -> let keys = [ key_0 ] in Ok (Some { sm_key; keys }) | _, _ -> Error (`Msg "secmod_signkey: invalid local file state.") let generate_fresh_keys () = 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_local_keys conn with | Ok None -> Fmt.pr "secmod_signkey: generate_fresh_keys@."; let t = generate_fresh_keys () in (*write_local_keys t |> Result.get_ok;*) t | Ok (Some v) -> Fmt.pr "secmod_signkey: loaded local keys@."; v | Error _ -> (* TODO pp error *) Fmt.failwith "secmod_signkey init failure." end module Secmod_denom = struct type t = { sm_key: Signkey.t; keys: Denomination.t list; } let v = let finally _key = () in Vif.Device.v ~name:"secmod_denom" ~finally [] @@ fun (_env : env) -> let sm_key = Signkey.generate () in let keys = List.map Denomination.make Config.Coin.all_coins in { sm_key; keys } end let secmod_signkey = Secmod_signkey.v let secmod_denom = Secmod_denom.v