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

JJ: Description from the destination commit:

Browse source 
+ currency config

JJ: Description from source commit:
better config: parse file + crunch
This commit is contained in:
swrup 2025-11-20 20:03:51 +01:00
parent 7597c02c1c
commit 9b6d845cb1
10 changed files with 326 additions and 256 deletions
Download patch file Download diff file Expand all files Collapse all files

147
include/parse_config.ml
View file

@ -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