From fe1639784ed5c7953c3c0bc843428bae4fc1cef1 Mon Sep 17 00:00:00 2001 From: swrup Date: Sat, 29 Nov 2025 15:32:45 +0100 Subject: [PATCH] add data_file.ml --- src/crypto.ml | 21 +++++++ src/data_file.ml | 93 +++++++++++++++++++++++++++++++ src/denomination.ml | 5 +- src/devices.ml | 133 +++++++++++++++++++++++--------------------- src/management.ml | 2 +- src/pg.ml | 2 +- 6 files changed, 187 insertions(+), 69 deletions(-) create mode 100644 src/data_file.ml diff --git a/src/crypto.ml b/src/crypto.ml index 639a0210..f5031c98 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -165,6 +165,27 @@ module RsaPublicKey = struct let jsont = Jsont.of_of_string ~kind:"RsaPublicKey" of_b32 ~enc:to_b32 end +module RsaPrivateKey = struct + open Mirage_crypto_pk.Rsa + + type t = priv + + let pub_of_priv = pub_of_priv + + (* TODO rsa *) + let to_octets _t : string = assert false + let of_octets _t : t = assert false + (*let bin = Bin.map (Bin.bytes 32) of_octets to_octets*) + + let of_b32 s = + let open Syntax in + let* octets = B32.decode s in + Ok (of_octets octets) + + let to_b32 t = B32.encode (to_octets t) + let jsont = Jsont.of_of_string ~kind:"EddsaPrivateKey" of_b32 ~enc:to_b32 +end + module RsaSignature : sig type t diff --git a/src/data_file.ml b/src/data_file.ml new file mode 100644 index 00000000..125f6f9a --- /dev/null +++ b/src/data_file.ml @@ -0,0 +1,93 @@ +open Bos.OS +open Syntax +open Crypto + +let read fname = + let* b = File.exists fname in + match b with + | false -> Ok None + | true -> + let+ content = File.read fname in + Some content + +let read_eddsa fname = + let+ content_opt = read fname in + Option.map EddsaPrivateKey.of_octets content_opt + +let read_rsa fname = + let+ content_opt = read fname in + Option.map RsaPrivateKey.of_octets content_opt + +let write_eddsa fname priv = EddsaPrivateKey.to_octets priv |> File.write fname +let write_rsa fname priv = RsaPrivateKey.to_octets priv |> File.write fname + +let load_signkey conn fname = + let* opt = read_eddsa fname in + match opt with + | None -> Ok None + | Some priv -> ( + let pub = EddsaPrivateKey.pub_of_priv priv in + let* opt = Pg.lookup_signing_key conn pub in + match opt with + | None -> + Fmt.error_msg + "load_signkey error no associated metadata found in database for \ + signkey `%s`." + (Fpath.to_string fname) + | Some (stamp_start, stamp_expire, stamp_end) -> + (* TODO master_sig *) + let master_sig = None in + let v = + Signkey. + { pub; priv; stamp_start; stamp_expire; stamp_end; master_sig } + in + Ok (Some v)) + +let load_denom conn ~section_name fname = + let* opt = read_rsa fname in + match opt with + | None -> Ok None + | Some priv -> ( + let pub = RsaPrivateKey.pub_of_priv priv in + let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in + let* opt = Pg.lookup_denomination_key conn h_pub in + match opt with + | None -> + Fmt.error_msg + "load_denom error no associated metadata found in database for \ + denom `%s`." + (Fpath.to_string fname) + | Some + ( stamp_start, + stamp_expire_withdraw, + stamp_expire_deposit, + stamp_expire_legal, + value, + fee_withdraw, + fee_deposit, + fee_refresh, + fee_refund, + age_mask ) -> + (* TODO master_sig *) + let master_sig = None in + let v = + Denomination. + { + pub; + priv; + section_name; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + age_mask; + h_pub; + master_sig; + } + in + Ok (Some v)) diff --git a/src/denomination.ml b/src/denomination.ml index 68aca301..32eb469d 100644 --- a/src/denomination.ml +++ b/src/denomination.ml @@ -2,6 +2,7 @@ open Crypto type t = { pub: RsaPublicKey.t; + priv: RsaPrivateKey.t; section_name: string; value: Amount.t; stamp_start: Timestamp.t; @@ -14,7 +15,6 @@ type t = { fee_refund: Amount.t; age_mask: int; h_pub: Bin_type.DenominationHash.t; - sign: string -> RsaSignature.t; master_sig: EddsaSignature.t option; } @@ -51,10 +51,10 @@ let make let priv = generate ~bits:rsa_keysize () in let pub = pub_of_priv priv in let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in - let sign = RsaSignature.sign ~key:priv in let master_sig = None in { pub; + priv; section_name; value; stamp_start; @@ -67,6 +67,5 @@ let make fee_refund; age_mask= 0; h_pub; - sign; master_sig; } diff --git a/src/devices.ml b/src/devices.ml index 78ed3877..a041e7ac 100644 --- a/src/devices.ml +++ b/src/devices.ml @@ -1,5 +1,4 @@ open Syntax -open Crypto type env = { caqti_switch: Caqti_miou.Switch.t; @@ -29,73 +28,31 @@ module Secmod_signkey = struct let dir = Fpath.(v "data" / "secmod_signkey") - let read_eddsa_key_files fname = - let open Bos.OS in - let fname = Fpath.(dir / fname) in - let* b = File.exists fname in - match b with - | false -> Ok None - | true -> - let+ content = File.read fname in - let priv = EddsaPrivateKey.of_octets content in - Some priv + 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 Bos.OS in - let fname = Fpath.(dir / fname) in - let content = EddsaPrivateKey.to_octets signkey.Signkey.priv in - let+ () = File.write fname content in - () - - let write_local_keys t = - 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 (fname, key) -> write_eddsa_key_files fname key) keys + let* sm_key = Data_file.load_signkey conn Fpath.(dir / "sm_key") in + let* key_0 = + let fname = Fpath.(dir / string_of_int 0) in + Data_file.load_signkey conn fname in - () - - let load_local_keys conn = - let load s = - let* opt = read_eddsa_key_files s in - match opt with - | None -> Ok None - | Some priv -> ( - let pub = EddsaPrivateKey.pub_of_priv priv in - 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) -> - (* TODO master_sig *) - 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.") + | _, _ -> 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 } @@ -105,9 +62,9 @@ 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 -> - let t = generate_fresh_keys () in + let t = generate_fresh_secmod_data () in t | Ok (Some v) -> v | Error _ -> @@ -121,12 +78,60 @@ 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 + 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 (List.for_all Option.is_none l, List.for_all Option.is_some l) with + | _, true -> + let l = List.map Option.get l in + Ok (Some l) + | true, _ -> Ok None + | _, _ -> error_invalid_state + 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 diff --git a/src/management.ml b/src/management.ml index c2bd0cd1..e1adf406 100644 --- a/src/management.ml +++ b/src/management.ml @@ -4,6 +4,7 @@ open Devices let mk_future_denom denom_key_signf ({ pub; + priv= _; section_name; value; stamp_start; @@ -16,7 +17,6 @@ let mk_future_denom denom_key_signf fee_refund; age_mask; h_pub; - sign= _; master_sig= _; } : Denomination.t) = diff --git a/src/pg.ml b/src/pg.ml index cca375c5..4c97f8a4 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -128,6 +128,7 @@ let add_denomination_key = Denomination. { pub; + priv= _; section_name= _; value; stamp_start; @@ -140,7 +141,6 @@ let add_denomination_key = fee_refund; age_mask; h_pub; - sign= _; master_sig; } ->