swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2026-02-17 14:20:29 +01:00
parent 62dddfe81f
commit e0a93025d9
1 changed files with 12 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

36
src/secmod.ml
View file

@ -70,24 +70,19 @@ module Make (Conn : Pg.CONN) = struct
let dn_key_fname section_name = let dn_key_fname section_name =
Fpath.(Config.secrets_dir / Fmt.str "dn_%s" section_name) Fpath.(Config.secrets_dir / Fmt.str "dn_%s" section_name)
let database_find_sk conn fname pub = let database_find_sk conn pub =
let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in let* opt = Pg.find_signkey conn pub |> unwrap_err_caqti in
match opt with match opt with
| None -> | None ->
Fmt.error Fmt.error "secmod failure: a signkey could not be found in database"
"load_signkey error, no associated data found in database for \
signkey `%s`."
(Fpath.to_string fname)
| Some sk_data -> Ok sk_data | Some sk_data -> Ok sk_data
let database_find_dn conn ~section_name h_pub = let database_find_dn conn h_pub =
let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in let* opt = Pg.find_denom conn h_pub |> unwrap_err_caqti in
match opt with match opt with
| None -> | None ->
Fmt.error Fmt.error
"load_denom error no associated metadata found in database for \ "secmod failure: a denomination could not be found in database"
denomination `%s`."
section_name
| Some dn_data -> Ok dn_data | Some dn_data -> Ok dn_data
(* TODO clean up *) (* TODO clean up *)
@ -98,13 +93,7 @@ module Make (Conn : Pg.CONN) = struct
let* sm_key = Data_file.read_eddsa sm_key_fname in let* sm_key = Data_file.read_eddsa sm_key_fname in
let* sk_keys = let* sk_keys =
let l = List.init 1 sk_key_fname in let l = List.init 1 sk_key_fname in
let* l = let* l = list_map (fun fname -> Data_file.read_eddsa fname) l in
list_map
(fun fname ->
let+ opt = Data_file.read_eddsa fname in
Option.map (fun priv -> (fname, priv)) opt)
l
in
match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt match opt_list l with Error () -> error_invalid_state | Ok opt -> Ok opt
in in
let* dn_keys = let* dn_keys =
@ -129,9 +118,9 @@ module Make (Conn : Pg.CONN) = struct
(* sk *) (* sk *)
let* l = let* l =
list_map list_map
(fun (fname, priv) -> (fun priv ->
let pub = EddsaPrivateKey.pub_of_priv priv in let pub = EddsaPrivateKey.pub_of_priv priv in
let+ sk = database_find_sk conn fname pub in let+ sk = database_find_sk conn pub in
((pub, sk), (pub, priv))) ((pub, sk), (pub, priv)))
sk_keys sk_keys
in in
@ -154,7 +143,7 @@ module Make (Conn : Pg.CONN) = struct
(* fill dn_section_name_ht *) (* fill dn_section_name_ht *)
Hashtbl.replace dn_section_name_ht h_pub section_name; Hashtbl.replace dn_section_name_ht h_pub section_name;
let+ dn = database_find_dn conn ~section_name h_pub in let+ dn = database_find_dn conn h_pub in
((h_pub, dn), (h_pub, priv))) ((h_pub, dn), (h_pub, priv)))
dn_keys dn_keys
in in
@ -224,17 +213,16 @@ module Make (Conn : Pg.CONN) = struct
age_restricted= _; age_restricted= _;
} = } =
assert (cipher = `RSA); assert (cipher = `RSA);
let open Time in let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in
let start = Absolute.of_ptime (Ptime_clock.now ()) in
let stamp_start = Timestamp.of_absolute start in let stamp_start = Timestamp.of_absolute start in
let stamp_expire_withdraw = let stamp_expire_withdraw =
Timestamp.of_absolute @@ Absolute.add start duration_withdraw Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw
in in
let stamp_expire_deposit = let stamp_expire_deposit =
Timestamp.of_absolute @@ Absolute.add start duration_spend Timestamp.of_absolute @@ Time.Absolute.add start duration_spend
in in
let stamp_expire_legal = let stamp_expire_legal =
Timestamp.of_absolute @@ Absolute.add start duration_legal Timestamp.of_absolute @@ Time.Absolute.add start duration_legal
in in
let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () in let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () in
let open Api in let open Api in