diff --git a/src/config.ml b/src/config.ml index c91ccfdb..136c8995 100644 --- a/src/config.ml +++ b/src/config.ml @@ -175,17 +175,6 @@ module Coin = struct } let all_coins = List.map parse_coin coin_sections - - let get_coin name = - match List.find_opt (fun v -> v.section_name = name) all_coins with - | None -> - fail_with - (Fmt.str "section `[coin_%s]` not found, coin `%s` is not defined" - name name) - | Some v -> v - - let kudo_1 = get_coin "kudo_1" - let kudo_2 = get_coin "kudo_2" end module Exchange_secmod_rsa = struct 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 b7a2007f..fc821823 100644 --- a/src/devices.ml +++ b/src/devices.ml @@ -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 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; } -> diff --git a/src/syntax.ml b/src/syntax.ml index da6c9b01..f354ca6c 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -38,3 +38,11 @@ let list_fold_left f acc l = let* acc = acc in f acc v) (Ok acc) l + +let opt_list l = + 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 ()