From 846122b49cb78d2c357488b6c3b12812566bdeae Mon Sep 17 00:00:00 2001 From: swrup Date: Sat, 6 Dec 2025 23:15:07 +0100 Subject: [PATCH] add secmod_denom.ml secmod_signkey.ml --- src/devices.ml | 157 ++++++++---------------------------------- src/management.ml | 1 - src/secmod_denom.ml | 47 +++++++++++++ src/secmod_signkey.ml | 44 ++++++++++++ src/signkey.ml | 7 +- 5 files changed, 121 insertions(+), 135 deletions(-) create mode 100644 src/secmod_denom.ml create mode 100644 src/secmod_signkey.ml diff --git a/src/devices.ml b/src/devices.ml index 440d7545..e91f0eb2 100644 --- a/src/devices.ml +++ b/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." diff --git a/src/management.ml b/src/management.ml index e56a6a2a..dc7e6331 100644 --- a/src/management.ml +++ b/src/management.ml @@ -1,5 +1,4 @@ open Api -open Devices let mk_future_denom ~sm_denom_priv ({ diff --git a/src/secmod_denom.ml b/src/secmod_denom.ml new file mode 100644 index 00000000..504e0755 --- /dev/null +++ b/src/secmod_denom.ml @@ -0,0 +1,47 @@ +open Syntax + +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 make_new () = + let sm_key = Signkey.make () in + let keys = List.map Denomination.make Config.Coin.all_coins in + { sm_key; keys } diff --git a/src/secmod_signkey.ml b/src/secmod_signkey.ml new file mode 100644 index 00000000..128a38c0 --- /dev/null +++ b/src/secmod_signkey.ml @@ -0,0 +1,44 @@ +(* TODO + - key rotation + - how many signkey to use? + we just use 1 for now *) +open Syntax + +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 make_new () = + let sm_key = Signkey.make () in + let keys = [ Signkey.make () ] in + { sm_key; keys } diff --git a/src/signkey.ml b/src/signkey.ml index 2b29662b..3c59043e 100644 --- a/src/signkey.ml +++ b/src/signkey.ml @@ -12,18 +12,13 @@ type t = { master_sig: EddsaSignature.t option; } -let generate () = - (* TODO - - look if it exists - - if not, create it (TOFU initialization scheme) - - write it *) +let make () = let stamp_start = Ptime_clock.now () |> Option.some in let stamp_expire = Timestamp.add_span_exn stamp_start (Some Config.Exchange.signkey_legal_duration) in let stamp_end = stamp_expire in - let priv, pub = Mirage_crypto_ec.Ed25519.generate () in let master_sig = None in { pub; priv; stamp_start; stamp_expire; stamp_end; master_sig }