rm util.ml + clean up
This commit is contained in:
parent
a23e59dfca
commit
439fdc6a30
7 changed files with 127 additions and 140 deletions
|
|
@ -9,35 +9,36 @@ open Time
|
|||
module Sfn = Mfat.Sfn
|
||||
module Spath = Mfat.Spath
|
||||
|
||||
module Coin_config = struct
|
||||
type t = {
|
||||
name: string;
|
||||
duration_withdraw: TimeRelative.t;
|
||||
rsa_keysize: int;
|
||||
}
|
||||
|
||||
let of_coin (coin : Config.Coin.t) =
|
||||
{
|
||||
name= coin.section_name;
|
||||
duration_withdraw= coin.duration_withdraw;
|
||||
rsa_keysize= coin.rsa_keysize;
|
||||
}
|
||||
end
|
||||
|
||||
module Cfg = struct
|
||||
open Config
|
||||
include Exchange_secmod_rsa
|
||||
include Config.Exchange_secmod_rsa
|
||||
|
||||
let sections = Coin.all_coins |> List.map (fun coin -> coin.Coin.section_name)
|
||||
let key_dir = Config.spath "/RSA"
|
||||
let sm_key = Config.spath "/SM_RSA"
|
||||
let coin_config_list = List.map Coin_config.of_coin Config.Coin.all_coins
|
||||
|
||||
(* helper functions to get config value from section_name: *)
|
||||
|
||||
let duration_withdraw =
|
||||
let duration_withdraw_assoc =
|
||||
Coin.all_coins
|
||||
|> List.map (fun coin -> (coin.Coin.section_name, coin.duration_withdraw))
|
||||
in
|
||||
fun ~section_name ->
|
||||
match List.assoc_opt section_name duration_withdraw_assoc with
|
||||
| None ->
|
||||
Fmt.failwith "section_name `%s` not found in config" section_name
|
||||
| Some v -> v
|
||||
|
||||
let rsa_keysize =
|
||||
let rsa_keysize_assoc =
|
||||
Coin.all_coins
|
||||
|> List.map (fun coin -> (coin.Coin.section_name, coin.rsa_keysize))
|
||||
in
|
||||
fun ~section_name ->
|
||||
match List.assoc_opt section_name rsa_keysize_assoc with
|
||||
| None ->
|
||||
Fmt.failwith "section_name `%s` not found in config" section_name
|
||||
| Some v -> v
|
||||
let get_coin_config ~section_name =
|
||||
coin_config_list
|
||||
|> List.find_opt (fun (cfg : Coin_config.t) ->
|
||||
String.equal cfg.name section_name)
|
||||
|> function
|
||||
| None ->
|
||||
Fmt.failwith "secmod_rsa failure: section `%s` not found" section_name
|
||||
| Some cfg -> cfg
|
||||
end
|
||||
|
||||
type key = {
|
||||
|
|
@ -107,32 +108,32 @@ let delete_file fs spath =
|
|||
|
||||
(* -- *)
|
||||
|
||||
let gen_key ~section_name t1 t2 =
|
||||
let bits = Cfg.rsa_keysize ~section_name in
|
||||
let priv, pub = RsaPrivateKey.generate ~bits () in
|
||||
let gen_key cfg t1 t2 =
|
||||
let priv, pub = RsaPrivateKey.generate ~bits:cfg.Coin_config.rsa_keysize () in
|
||||
let h_pub = DenominationHash.hash_of_rsa pub in
|
||||
let k = { section_name; priv; pub; h_pub; t1; t2 } in
|
||||
let k = { section_name= cfg.name; priv; pub; h_pub; t1; t2 } in
|
||||
Log.debug (fun m ->
|
||||
m "generated key %s `%s`" section_name (DenominationHash.to_b32 k.h_pub));
|
||||
m "generated key %s `%s`" cfg.Coin_config.name
|
||||
(DenominationHash.to_b32 k.h_pub));
|
||||
k
|
||||
|
||||
let sort_keys l = List.sort (fun a b -> TimeAbsolute.compare a.t2 b.t2) l
|
||||
|
||||
let split_in_periodes ~start ~end_ ~duration_withdraw =
|
||||
let split_in_periodes (cfg : Coin_config.t) ~start ~end_ =
|
||||
assert (start < end_);
|
||||
(* no overlap on first periode *)
|
||||
let t1 = start in
|
||||
let t2 = TimeAbsolute.add start duration_withdraw in
|
||||
let t2 = TimeAbsolute.add start cfg.duration_withdraw in
|
||||
let acc = [ (t1, t2) ] in
|
||||
let start = t2 in
|
||||
let rec go acc start end_ =
|
||||
let t1 = TimeAbsolute.sub start Cfg.overlap_duration in
|
||||
let t2 = TimeAbsolute.add start duration_withdraw in
|
||||
let t2 = TimeAbsolute.add start cfg.duration_withdraw in
|
||||
if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
|
||||
in
|
||||
go acc start end_
|
||||
|
||||
let gen_additional_keys_until_lookahead ~now ~section_name l =
|
||||
let gen_additional_keys_until_lookahead cfg ~now l =
|
||||
let start =
|
||||
match List.rev (sort_keys l) with
|
||||
| [] -> now
|
||||
|
|
@ -141,11 +142,8 @@ let gen_additional_keys_until_lookahead ~now ~section_name l =
|
|||
let end_ = TimeAbsolute.add now Cfg.lookahead_sign in
|
||||
if TimeAbsolute.compare start end_ >= 0 then []
|
||||
else
|
||||
let duration_withdraw = Cfg.duration_withdraw ~section_name in
|
||||
let periodes = split_in_periodes ~start ~end_ ~duration_withdraw in
|
||||
let new_keys =
|
||||
List.map (fun (t1, t2) -> gen_key ~section_name t1 t2) periodes
|
||||
in
|
||||
let periodes = split_in_periodes cfg ~start ~end_ in
|
||||
let new_keys = List.map (fun (t1, t2) -> gen_key cfg t1 t2) periodes in
|
||||
new_keys
|
||||
|
||||
let load fs =
|
||||
|
|
@ -154,16 +152,13 @@ let load fs =
|
|||
else Fat.mkdir fs Cfg.key_dir |> unwrap_msg
|
||||
in
|
||||
let* l = Fat.ls fs Cfg.key_dir |> unwrap_msg in
|
||||
let l = List.map (fun entry -> entry.Fat.name) l in
|
||||
let l = List.map (Spath.add Cfg.key_dir) l in
|
||||
let l =
|
||||
List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_priv_key) l
|
||||
in
|
||||
let l = List.map (fun entry -> Spath.add Cfg.key_dir entry.Fat.name) l in
|
||||
let l = List.filter (fun spath -> not @@ Spath.equal spath Cfg.sm_key) l in
|
||||
let* keys = list_map (read_key fs) l in
|
||||
match keys with
|
||||
| [] -> Ok None
|
||||
| _l ->
|
||||
let* sm_priv, sm_pub = read_eddsa fs Cfg.sm_priv_key in
|
||||
let* sm_priv, sm_pub = read_eddsa fs Cfg.sm_key in
|
||||
let ht = Hashtbl.create 0xff in
|
||||
let () = List.iter (fun k -> Hashtbl.replace ht k.h_pub k) keys in
|
||||
Ok (Some { fs; sm_priv; sm_pub; ht })
|
||||
|
|
@ -178,19 +173,16 @@ let init fs =
|
|||
let sm_priv, sm_pub = EddsaPrivateKey.generate () in
|
||||
Log.debug (fun m ->
|
||||
m "generated secmod key: `%s`" (EddsaPublicKey.to_b32 sm_pub));
|
||||
let* () = write_eddsa fs Cfg.sm_priv_key sm_priv in
|
||||
let* () = write_eddsa fs Cfg.sm_key sm_priv in
|
||||
let ht = Hashtbl.create 0xff in
|
||||
Ok { fs; sm_priv; sm_pub; ht }
|
||||
in
|
||||
let all_keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
|
||||
let new_keys_l =
|
||||
List.map
|
||||
(fun section_name ->
|
||||
let keys =
|
||||
List.filter (fun k -> k.section_name = section_name) all_keys
|
||||
in
|
||||
gen_additional_keys_until_lookahead ~now ~section_name keys)
|
||||
Cfg.sections
|
||||
Cfg.coin_config_list
|
||||
|> List.map (fun (cfg : Coin_config.t) ->
|
||||
let keys = List.filter (fun k -> k.section_name = cfg.name) all_keys in
|
||||
gen_additional_keys_until_lookahead cfg ~now keys)
|
||||
in
|
||||
let new_keys = List.concat new_keys_l in
|
||||
List.iter (fun k -> Hashtbl.replace t.ht k.h_pub k) new_keys;
|
||||
|
|
@ -218,8 +210,8 @@ module Make (Fs : Fat.FS) = struct
|
|||
|> List.map (fun (h_pub, _k) -> h_pub)
|
||||
|> list_iter delete
|
||||
|
||||
let add section_name t1 t2 =
|
||||
let k = gen_key ~section_name t1 t2 in
|
||||
let add cfg t1 t2 =
|
||||
let k = gen_key cfg t1 t2 in
|
||||
let+ () = write_key t.fs k in
|
||||
Hashtbl.replace t.ht k.h_pub k;
|
||||
()
|
||||
|
|
@ -237,7 +229,8 @@ module Make (Fs : Fat.FS) = struct
|
|||
m "revoke `%s`" (DenominationHash.to_octets h_pub |> B32.encode));
|
||||
let* k = find h_pub in
|
||||
let* () = delete h_pub in
|
||||
let* () = add k.section_name k.t1 k.t2 in
|
||||
let cfg = Cfg.get_coin_config ~section_name:k.section_name in
|
||||
let* () = add cfg k.t1 k.t2 in
|
||||
Ok ()
|
||||
|
||||
let conv =
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue