add data_file.ml

This commit is contained in:
swrup 2025-11-29 14:03:37 +01:00
parent 760e6de1fb
commit bc91f7357c
8 changed files with 207 additions and 101 deletions

View file

@ -1,3 +1,5 @@
open Syntax
type env = {
caqti_switch: Caqti_miou.Switch.t;
db_uri: Uri.t;
@ -16,9 +18,11 @@ let db_connection : (env, Caqti_miou.connection) Vif.Device.device =
Fmt.failwith "Database preflight failure: %a." Caqti_error.pp err
| Ok () -> conn)
(* TODO KV store *)
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;
@ -26,83 +30,34 @@ module Secmod_signkey = struct
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 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 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
let load conn =
let error_invalid_state =
Fmt.error_msg "secmod_signkey load error: invalid store state."
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;
}))
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
let* sm_key = load "sm_key" in
let* key_0 = load "0" in
match (sm_key, key_0) with
match (sm_key, keys) 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.")
| Some sm_key, Some keys -> Ok (Some { sm_key; keys })
| _, _ -> error_invalid_state
let generate_fresh_keys () =
let generate_fresh_secmod_data () =
let sm_key = Signkey.generate () in
let keys = [ Signkey.generate () ] in
{ sm_key; keys }
@ -112,17 +67,13 @@ module Secmod_signkey = struct
Vif.Device.v ~name:"secmod_signkey" ~finally
[ Vif.Device.value db_connection ]
@@ fun conn (_env : env) ->
match load_local_keys conn with
match load conn with
| Ok None ->
Fmt.pr "secmod_signkey: generate_fresh_keys@.";
let t = generate_fresh_keys () in
(*write_local_keys t |> Result.get_ok;*)
let t = generate_fresh_secmod_data () in
t
| Ok (Some v) ->
Fmt.pr "secmod_signkey: loaded local keys@.";
v
| Ok (Some v) -> v
| Error _ ->
(* TODO pp error *)
(* TODO error: pretty print *)
Fmt.failwith "secmod_signkey init failure."
end
@ -132,12 +83,57 @@ module Secmod_denom = struct
keys: Denomination.t list;
}
let v =
let finally _key = () in
Vif.Device.v ~name:"secmod_denom" ~finally [] @@ fun (_env : env) ->
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