better config: parse file + crunch
This commit is contained in:
parent
7597c02c1c
commit
f48bc395ee
10 changed files with 326 additions and 256 deletions
|
|
@ -14,10 +14,10 @@
|
|||
(modules gen_eddsa_key)
|
||||
(libraries fmt mirage-crypto-rng.unix mirage-crypto-ec b32))
|
||||
|
||||
(executable
|
||||
(library ; todo: should I have a /lib?
|
||||
(name parse_config)
|
||||
(modules parse_config)
|
||||
(libraries mirage-crypto-ec ptime fmt angstrom amount b32))
|
||||
(libraries mirage-crypto-ec ptime fmt angstrom uri amount b32))
|
||||
|
||||
; we prefer to generate taler_signatures.ml once,
|
||||
; and commit it, for versionning:
|
||||
|
|
|
|||
|
|
@ -3,11 +3,6 @@
|
|||
|
||||
do not support "$"-path expansion*)
|
||||
|
||||
(* TODO
|
||||
- do all config section
|
||||
- parse alt_unit_names json pair
|
||||
*)
|
||||
|
||||
open Angstrom
|
||||
|
||||
type item = {
|
||||
|
|
@ -21,14 +16,14 @@ type section = {
|
|||
}
|
||||
|
||||
let fail_with msg =
|
||||
Fmt.epr "Failed to parse configuration: %s.@." msg;
|
||||
Fmt.epr "Configuration failure: %s.@." msg;
|
||||
exit 1
|
||||
|
||||
let is_eol = function '\n' | '\r' -> true | _ -> false
|
||||
let is_whitespace = function ' ' | '\t' -> true | _ -> false
|
||||
let whitespace = skip_while is_whitespace
|
||||
|
||||
module Parse_file = struct
|
||||
module Parse_data = struct
|
||||
type line =
|
||||
| Blank
|
||||
| Comment of string
|
||||
|
|
@ -90,7 +85,7 @@ module Parse_file = struct
|
|||
in
|
||||
loop [] [] (List.rev l)
|
||||
|
||||
let parse_content s =
|
||||
let parse s =
|
||||
match parse_string ~consume:All config s with
|
||||
| Error msg -> fail_with (Fmt.str "parse error `%s`" msg)
|
||||
| Ok v -> fold_sections v
|
||||
|
|
@ -105,7 +100,7 @@ module Pp_debug = struct
|
|||
|
||||
let pp_line ppf line =
|
||||
let open Fmt in
|
||||
let open Parse_file in
|
||||
let open Parse_data in
|
||||
match line with
|
||||
| Blank -> Fmt.nop ppf ()
|
||||
| Comment s -> pf ppf "#%s" s
|
||||
|
|
@ -205,14 +200,14 @@ let get t ~section ~field =
|
|||
| None -> fail_with (Fmt.str "option `[%s].%s` not found" section field)
|
||||
| Some v -> v
|
||||
|
||||
let int v =
|
||||
match int_of_string_opt v with
|
||||
| None -> fail_with (Fmt.str "expected int value, got `%s`" v)
|
||||
let int s =
|
||||
match int_of_string_opt s with
|
||||
| None -> fail_with (Fmt.str "expected int value, got `%s`" s)
|
||||
| Some v -> v
|
||||
|
||||
let float v =
|
||||
match float_of_string_opt v with
|
||||
| None -> fail_with (Fmt.str "expected float value, got `%s`" v)
|
||||
let float s =
|
||||
match float_of_string_opt s with
|
||||
| None -> fail_with (Fmt.str "expected float value, got `%s`" s)
|
||||
| Some v -> v
|
||||
|
||||
let const_value a b =
|
||||
|
|
@ -225,91 +220,57 @@ let yes_no = function
|
|||
| "YES" -> `YES
|
||||
| s -> fail_with (Fmt.str "expected `YES`/`NO` value, got `%s`" s)
|
||||
|
||||
let amount v = v |> Amount.of_string |> unwrap_res
|
||||
let duration v = Parse_duration.(v |> parse |> to_ptime_span)
|
||||
let uri s = Uri.of_string s
|
||||
let amount s = s |> Amount.of_string |> unwrap_res
|
||||
let duration s = Parse_duration.(s |> parse |> to_ptime_span)
|
||||
|
||||
let ed25519 v =
|
||||
v
|
||||
let ed25519 s =
|
||||
s
|
||||
|> B32.decode
|
||||
|> unwrap_res
|
||||
|> Mirage_crypto_ec.Ed25519.pub_of_octets
|
||||
|> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
|
||||
|> unwrap_res
|
||||
|
||||
module Config = struct
|
||||
[@@@ocaml.warning "-32"]
|
||||
module Parse_alt_unit_names = struct
|
||||
let rm_brackets s =
|
||||
let s = String.trim s in
|
||||
match
|
||||
String.starts_with ~prefix:"{" s && String.ends_with ~suffix:"}" s
|
||||
with
|
||||
| false -> fail_with (Fmt.str "expected json, got `%s`" s)
|
||||
| true ->
|
||||
let s = String.sub s 1 (String.length s - 2) in
|
||||
s
|
||||
|
||||
let config =
|
||||
let read_file file = In_channel.with_open_bin file In_channel.input_all in
|
||||
let content = read_file "default.config" in
|
||||
let v = Parse_file.parse_content content in
|
||||
(*Fmt.pr "config file:@\n%a@." Pp_debug.pp_config v;*)
|
||||
v
|
||||
let rm_quotes s =
|
||||
let s = String.trim s in
|
||||
match
|
||||
String.starts_with ~prefix:"\"" s && String.ends_with ~suffix:"\"" s
|
||||
with
|
||||
| false -> fail_with (Fmt.str "expected quoted string, got `%s`" s)
|
||||
| true ->
|
||||
let s = String.sub s 1 (String.length s - 2) in
|
||||
s
|
||||
|
||||
module Exchange = struct
|
||||
let get_opt field = get_opt config ~section:"exchange" ~field
|
||||
let get field = get config ~section:"exchange" ~field
|
||||
|
||||
(* - *)
|
||||
let currency = (* todo: constraint on currency string *) get "currency"
|
||||
let currency_round_unit = get "currency_round_unit" |> amount
|
||||
let db = get "db" |> const_value "postgres"
|
||||
let attribute_encryption_key = get "attribute_encryption_key"
|
||||
let port = get "port" |> int
|
||||
let bind_to = get "bind_to"
|
||||
let master_public_key = get "master_public_key" |> ed25519
|
||||
let stefan_abs = get "stefan_abs" |> amount
|
||||
let stefan_log = get "stefan_log" |> amount
|
||||
let stefan_lin = get_opt "stefan_lin" |> Option.map float
|
||||
|
||||
let aggregator_idle_sleep_interval =
|
||||
get "aggregator_idle_sleep_interval" |> duration
|
||||
|
||||
let closer_idle_sleep_interval =
|
||||
get "closer_idle_sleep_interval" |> duration
|
||||
|
||||
let transfer_idle_sleep_interval =
|
||||
get "transfer_idle_sleep_interval" |> duration
|
||||
|
||||
let wirewatch_idle_sleep_interval =
|
||||
get "wirewatch_idle_sleep_interval" |> duration
|
||||
|
||||
let signkey_legal_duration = get "signkey_legal_duration" |> duration
|
||||
let max_keys_caching = get "max_keys_caching" |> duration
|
||||
let enable_kyc = get "enable_kyc" |> yes_no
|
||||
|
||||
(* optional:
|
||||
tiny_amount
|
||||
shopping_url
|
||||
open_banking_gateway_url
|
||||
aml_spa_dialect
|
||||
bank_compliance_language
|
||||
toplevel_redirect_url *)
|
||||
(* not implemented or not relevant to MTE:
|
||||
let max_requests = get "max_requests" |> int
|
||||
base_url
|
||||
aggregator_shard_size
|
||||
serve
|
||||
unixpath
|
||||
unixpath_mode
|
||||
terms_dir
|
||||
terms_etag
|
||||
privacy_dir
|
||||
privacy_etag *)
|
||||
end
|
||||
|
||||
module Exchangedb = struct
|
||||
let get field = get config ~section:"exchangedb" ~field
|
||||
|
||||
(* - *)
|
||||
let idle_reserve_expiration_time =
|
||||
get "idle_reserve_expiration_time" |> duration
|
||||
|
||||
let legal_reserve_expiration_time =
|
||||
get "legal_reserve_expiration_time" |> duration
|
||||
|
||||
let aggregator_shift = get "aggregator_shift" |> duration
|
||||
let max_aml_program_runtime = get "max_aml_program_runtime" |> duration
|
||||
let default_purse_limit = get "default_purse_limit" |> int
|
||||
end
|
||||
let parse s =
|
||||
let s = rm_brackets s in
|
||||
String.split_on_char ',' s
|
||||
|> List.map (String.split_on_char ':')
|
||||
|> List.map (function
|
||||
| [ k; v ] -> (k, v)
|
||||
| _ -> fail_with "invalid json key-value map")
|
||||
|> List.map (fun (k, v) ->
|
||||
let k = rm_quotes k in
|
||||
let v = rm_quotes v in
|
||||
let k =
|
||||
match int_of_string_opt k with
|
||||
| None ->
|
||||
fail_with
|
||||
(Fmt.str
|
||||
"invalid json key-value map, expected integer key, got `%s`"
|
||||
k)
|
||||
| Some k -> k
|
||||
in
|
||||
(k, v))
|
||||
end
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue