From 26a1c0f8359314d8d0a48e5d9dd9b95a20912168 Mon Sep 17 00:00:00 2001 From: swrup Date: Thu, 20 Nov 2025 18:38:01 +0100 Subject: [PATCH] JJ: Description from the destination commit: better config: parse file + crunch JJ: Description from source commit: rm taler_config_type.ml --- default.config | 17 --- include/dune | 4 +- include/parse_config.ml | 284 ++++++++++++++++++++++++----------- include/taler_config_type.ml | 175 --------------------- src/amount.ml | 22 ++- src/assets.ml | 12 +- src/assets/default.config | 73 +++++++++ src/config.ml | 266 ++++++++++++++++++++++---------- src/denomination.ml | 2 +- src/devices.ml | 2 +- src/dune | 1 + src/types.ml | 32 ---- 12 files changed, 481 insertions(+), 409 deletions(-) delete mode 100644 default.config delete mode 100644 include/taler_config_type.ml create mode 100644 src/assets/default.config diff --git a/default.config b/default.config deleted file mode 100644 index 7f586cae..00000000 --- a/default.config +++ /dev/null @@ -1,17 +0,0 @@ -# comment 1 -# foo -# barr -[currency-EUR] -enabled = NO - # comment 2 -code= "EUR" -name =euro -fractional_input_digits = 2 -fractional_normal_digits =2 -fractional_trailing_zero_digits= 2 - % comment 3 -alt_unit_names = "{"0":"€","3":"k€"}" -% comment 4 - -[dummy-section] -dummy = "blah" diff --git a/include/dune b/include/dune index d9601600..a68f7d3c 100644 --- a/include/dune +++ b/include/dune @@ -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 fmt angstrom amount)) + (libraries mirage-crypto-ec ptime fmt angstrom uri amount b32)) ; we prefer to generate taler_signatures.ml once, ; and commit it, for versionning: diff --git a/include/parse_config.ml b/include/parse_config.ml index 58d9bc4a..115d1af7 100644 --- a/include/parse_config.ml +++ b/include/parse_config.ml @@ -3,64 +3,33 @@ do not support "$"-path expansion*) -(* TODO - - integer - - duration - - YES|NO - - alt_unit_names json pair +open Angstrom -type duration_element = { - number: int; - unit_: [ `Year | `Week | `Day | `Hour | `Minute | `Second ]; +type item = { + key: string; + value: string; } -let integer = - take_while1 (function '0' .. '9' -> true | _ -> false) >>= fun s -> - match int_of_string_opt s with - | None -> fail "not an integer" - | Some i -> return i +type section = { + header: string; + items: item list; +} -let duration_value = - let number = whitespace *> integer in - let unit = - whitespace *> take_while1 (fun c -> not (is_whitespace c || is_eol c)) - >>= function - | "year" | "years" -> return `Year - | "week" | "weeks" -> return `Week - | "day" | "days" -> return `Day - | "hour" | "hours" -> return `Hour - | "minute" | "minutes" -> return `Minute - | "s" -> return `Second - | _ -> fail "not a valid duration unit" - in - many1 (lift2 (fun number unit_ -> { number; unit_ }) number unit) -*) +let fail_with msg = + Fmt.epr "Configuration failure: %s.@." msg; + exit 1 -let read_file file = In_channel.with_open_bin file In_channel.input_all - -module Untyped = struct - type item = { - key: string; - value: string; - } +let is_eol = function '\n' | '\r' -> true | _ -> false +let is_whitespace = function ' ' | '\t' -> true | _ -> false +let whitespace = skip_while is_whitespace +module Parse_data = struct type line = | Blank | Comment of string | Header of string | Item of item - type section = { - header: string; - items: item list; - } - - open Angstrom - - let is_eol = function '\n' | '\r' -> true | _ -> false - let is_whitespace = function ' ' | '\t' -> true | _ -> false - let whitespace = skip_while is_whitespace - let id = let ident_char = function | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true @@ -86,7 +55,7 @@ module Untyped = struct let quoted_value = char '"' *> take_till is_eol >>= fun s -> match String.ends_with ~suffix:"\"" s with - | false -> fail "invalid quoted value" + | false -> fail_with "invalid quoted value" | true -> let value = String.sub s 0 (String.length s - 1) in return value @@ -107,7 +76,7 @@ module Untyped = struct match l with | [] -> if List.is_empty item_l then section_l - else Fmt.failwith "invalid config structure" + else fail_with "invalid configuration structure" | Blank :: tl | Comment _ :: tl -> loop section_l item_l tl | Item item :: tl -> loop section_l (item :: item_l) tl | Header header :: tl -> @@ -118,43 +87,190 @@ module Untyped = struct let parse s = match parse_string ~consume:All config s with - | Error msg -> Fmt.failwith "config parse error: %s" msg + | Error msg -> fail_with (Fmt.str "parse error `%s`" msg) | Ok v -> fold_sections v - - module Pp_debug = struct - let pp_item ppf { key; value } = - let open Fmt in - match String.contains value '"' || String.contains value ' ' with - | false -> pf ppf "%s = %s" key value - | true -> pf ppf "%s = \"%s\"" key value - - let pp_line ppf line = - let open Fmt in - match line with - | Blank -> Fmt.nop ppf () - | Comment s -> pf ppf "#%s" s - | Header s -> pf ppf "[%s]" s - | Item item -> pf ppf "%a" pp_item item - - let _pp_lines ppf raw_line_l = - let open Fmt in - pf ppf "%a" (list ~sep:(any "\n") pp_line) raw_line_l - - let pp_section ppf { header; items } = - let open Fmt in - pf ppf "[%s]@\n%a" header (list ~sep:(any "\n") pp_item) items - - let pp_config ppf l = - let open Fmt in - pf ppf "%a" (list ~sep:(any "\n") pp_section) l - end end -let () = - let content = read_file "default.config" in - (*Fmt.pr "%s" content;*) - let config = Untyped.parse content in - (*Fmt.pr "%a@." pp_lines config;*) - Fmt.pr "%a@." Untyped.Pp_debug.pp_config config; +module Pp_debug = struct + let pp_item ppf { key; value } = + let open Fmt in + match String.contains value '"' || String.contains value ' ' with + | false -> pf ppf "%s = %s" key value + | true -> pf ppf "%s = \"%s\"" key value - () + let pp_line ppf line = + let open Fmt in + let open Parse_data in + match line with + | Blank -> Fmt.nop ppf () + | Comment s -> pf ppf "#%s" s + | Header s -> pf ppf "[%s]" s + | Item item -> pf ppf "%a" pp_item item + + let _pp_lines ppf raw_line_l = + let open Fmt in + pf ppf "%a" (list ~sep:(any "\n") pp_line) raw_line_l + + let pp_section ppf { header; items } = + let open Fmt in + pf ppf "[%s]@\n%a" header (list ~sep:(any "\n") pp_item) items + + let pp_config ppf l = + let open Fmt in + pf ppf "%a" (list ~sep:(any "\n") pp_section) l +end +[@@ocaml.warning "-32"] + +module Parse_duration = struct + type duration_element = { + number: int; + dunit: [ `Year | `Week | `Day | `Hour | `Minute | `Second ]; + } + + let integer = + take_while1 (function '0' .. '9' -> true | _ -> false) >>= fun s -> + match int_of_string_opt s with + | None -> fail_with (Fmt.str "expected integer, got `%s`" s) + | Some i -> return i + + let duration_element = + let number = whitespace *> integer in + let dunit = + whitespace *> take_while1 (fun c -> not (is_whitespace c || is_eol c)) + >>= function + | "year" | "years" -> return `Year + | "week" | "weeks" -> return `Week + | "day" | "days" -> return `Day + | "hour" | "hours" -> return `Hour + | "minute" | "minutes" -> return `Minute + | "second" | "seconds" | "s" -> return `Second + | s -> fail_with (Fmt.str "expected a duration unit, got `%s`" s) + in + lift2 (fun number dunit -> { number; dunit }) number dunit + + let duration = many1 duration_element <* end_of_input + + let dunit_to_seconds u = + let rec f = function + | `Year -> 365 * f `Day + | `Week -> 7 * f `Day + | `Day -> 24 * f `Hour + | `Hour -> 60 * f `Minute + | `Minute -> 60 * f `Second + | `Second -> 1 + in + f u + + let ptime_span_of_int64 i = + match Ptime.Span.of_float_s (Int64.to_float i) with + | None -> + fail_with + (Fmt.str "ptime_span_of_int64 error: `%Ld` is not a valid ptime span" + i) + | Some ts -> ts + + let to_ptime_span t = + let acc = + List.fold_left + (fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit)) + 0 t + in + let acc = Int64.of_int acc in + let ptime = ptime_span_of_int64 acc in + ptime + + let parse s : duration_element list = + match parse_string ~consume:All duration s with + | Error msg -> fail_with (Fmt.str "duration parse error `%s`" msg) + | Ok v -> v +end + +let unwrap_res = function Error e -> fail_with (Fmt.str "`%s`." e) | Ok v -> v + +let get_opt t ~section ~field = + match List.find_opt (fun v -> v.header = section) t with + | None -> None + | Some v -> ( + match List.find_opt (fun item -> item.key = field) v.items with + | None -> None + | Some item -> Some item.value) + +let get t ~section ~field = + match get_opt t ~section ~field with + | None -> fail_with (Fmt.str "option `[%s].%s` not found" section field) + | Some v -> 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 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 = + match a = b with + | false -> fail_with (Fmt.str "unexpected value `%s`" b) + | true -> a + +let yes_no = function + | "NO" -> `NO + | "YES" -> `YES + | s -> fail_with (Fmt.str "expected `YES`/`NO` value, got `%s`" s) + +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 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 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 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 + + 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 diff --git a/include/taler_config_type.ml b/include/taler_config_type.ml deleted file mode 100644 index 925e08b9..00000000 --- a/include/taler_config_type.ml +++ /dev/null @@ -1,175 +0,0 @@ -(* https://docs.taler.net/manpages/taler-exchange.conf.5.html - taler-docs/manpages/taler-exchange.conf.5.rst *) -(* TODO - - generate `config.ml` from config file (virtual module)? - - parse config file format - - no relative path - - default config - - better types - - impl duration - *) - -(* TODO unikernel *) -type dir_path -type file_path - -(* TODO *) -(* Values that represent a time duration are represented as a series of one or more NUMBER UNIT pairs, e.g. 60 s, 4 weeks 1 day, 5 years 2 minutes. *) -type duration - -(* TODO - make it Amount.t *) -type amount = string -type payto_uri = string - -(* TODO - still need to parse them and tell that its not supported - some maybe are relevant - idk *) -type not_relevant -type url = string -type seconds = int - -(* not relevant for mirage *) -(* this contains path that can be referenced in other with $PATH - (unsupported) *) -module type Global = sig - val taler_home : dir_path - val taler_data_home : dir_path - val taler_config_home : dir_path - val taler_cache_home : dir_path - val taler_runtime_dir : dir_path -end - -(* sections "[currency-$NAME]" - see DD51 *) -module type Currency = sig - val enabled : [ `YES | `NO ] - val code : string - val name : string - val fractional_input_digits : int - val fractional_normal_digits : int - val fractional_trailing_zero_digits : int - val alt_unit_names : (int * string) list -end - -(* section "[exchange]" *) -module type Exchange = sig - val currency : string - val currency_round_unit : amount - val db : string - val attribute_encryption_key : string - val serve : [ `Unix | `Tcp | `Systemd ] - val unixpath : file_path - val unixpath_mode : int - val port : int - val bind_to : string - val master_public_key : string - val tiny_amount : amount option - val shopping_url : url option - val open_banking_gateway_url : url option - val aml_spa_dialect : string option - val bank_compliance_language : string option - val stefan_abs : amount - val stefan_log : amount - val stefan_lin : float - val base_url : url - val toplevel_redirect_url : string option - val aggregator_idle_sleep_interval : seconds - val closer_idle_sleep_interval : seconds - val transfer_idle_sleep_interval : seconds - val wirewatch_idle_sleep_interval : seconds - val aggregator_shard_size : int option - val signkey_legal_duration : duration - val max_keys_caching : duration - val max_requests : int - val terms_dir : dir_path - val terms_etag : string - val privacy_dir : dir_path - val privacy_etag : string - val enable_kyc : [ `YES | `NO ] -end - -(* section "[taler-exchange-secmod-{rsa|cs|eddsa}]". *) -module type Secmod = sig - val lookahead_sign : duration - val overlap_duration : duration - val sm_priv_key : file_path - val key_dir : dir_path - val unixpath : not_relevant -end - -module type Secmod_rsa = Secmod -module type Secmod_cs = Secmod -module type Secmod_eddsa = Secmod - -(* TODO config - what is the time/duration unit used here? *) -(* section "[exchangedb]". *) -module type Database = sig - val idle_reserve_expiration_time : seconds - val legal_reserve_expiration_time : seconds - val aggregator_shift : seconds - val default_purse_limit : int - val max_aml_program_runtime : int option - - module type Postgres_backend = sig - val config : string - end -end - -(* sections "[coin_XXX]" - used by secmods *) -module type Coin = sig - val value : amount - val duration_withdraw : duration - val duration_spend : duration - val duration_legal : duration - val fee_withdraw : amount - val fee_deposit : amount - val fee_refresh : amount - val fee_refund : amount - val cipher : [ (* `CS |*) `RSA ] - val rsa_keysize : int option (*only if `RSA *) - val age_restricted : [ (*`YES|*) `NO ] -end - -(* sections "[exchange-account-XXX]" *) -module type Account = sig - val payto_uri : payto_uri - val enable_debit : [ `YES | `NO ] - val enable_credit : [ `YES | `NO ] -end - -(* sections "[exchange-accountcredentials-XXX]" - must exists for each "[exchange-account-XXX]" section - - ! credentials to access the bank account - should be in a secret configuration file - only redable for `taler-exchange-wirewatch` `taler-exchange-transfer` processes *) -module type Account_secret = sig - val wire_gateway_url : url - val wire_gateway_auth_method : string - val username : string - val password : string - val token : string -end - -(* section "[exchange-extension-]" *) -module type Extensions = sig - val enabled : [ (*`YES|*) `NO ] -end - -(* section "[exchange-offline]". *) -module type Offline_signing = sig - val master_priv_file : file_path - - (* TODO - - we need two different file here - - there is three, not two, crypto helper modules - is it only two, because the eddsa one is not comptabilized as a "crypto helper" here? *) - (* tofu = Trust On First Use *) - val secm_tofu_file : file_path - val secm_denom_pubkey : string option - val secm_esign_pubkey : string option -end diff --git a/src/amount.ml b/src/amount.ml index 5123ac37..9640642c 100644 --- a/src/amount.ml +++ b/src/amount.ml @@ -35,19 +35,15 @@ let make ~sign ~currency ~value ~fraction = in Ok { sign; currency; value; fraction } -let to_string = - let pp = - let open Fmt in - let pp_sign ppf = function - | `Plus -> char ppf '+' - | `Minus -> char ppf '-' - in - let pp_currency ppf = function `Eur -> string ppf "EUR" in - fun ppf { sign; currency; value; fraction } -> - pf ppf "%a%a:%Ld.%02ld" (Fmt.option pp_sign) sign pp_currency currency - value fraction - in - Fmt.str "%a" pp +let pp = + let open Fmt in + let pp_sign ppf = function `Plus -> char ppf '+' | `Minus -> char ppf '-' in + let pp_currency ppf = function `Eur -> string ppf "EUR" in + fun ppf { sign; currency; value; fraction } -> + pf ppf "%a%a:%Ld.%02ld" (Fmt.option pp_sign) sign pp_currency currency value + fraction + +let to_string = Fmt.str "%a" pp let of_string = let open Angstrom in diff --git a/src/assets.ml b/src/assets.ml index 846291fa..f27b520b 100644 --- a/src/assets.ml +++ b/src/assets.ml @@ -51,21 +51,23 @@ module Mimetype = struct let pp_mime fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime) end +(* TODO config *) type t = | Terms | Privacy -let etag = function - | Terms -> Config.Exchange.terms_etag - | Privacy -> Config.Exchange.privacy_etag +let etag k = + Result.get_ok + @@ Headers_lib.Etag.of_crockford32 + @@ match k with Terms -> "0" | Privacy -> "0" let legal_version = function | Terms -> terms_legal_version | Privacy -> privacy_legal_version let base_dir = function - | Terms -> Config.Exchange.terms_dir - | Privacy -> Config.Exchange.privacy_dir + | Terms -> Fpath.v "terms" + | Privacy -> Fpath.v "privacy" (* TODO better use of Fmt to have error prefix or smthing diff --git a/src/assets/default.config b/src/assets/default.config new file mode 100644 index 00000000..0c401640 --- /dev/null +++ b/src/assets/default.config @@ -0,0 +1,73 @@ +[currency-EUR] +enabled= YES +code= EUR +name= euro +fractional_input_digits= 2 +fractional_normal_digits= 2 +fractional_trailing_zero_digits= 2 +alt_unit_names= "{"0":"€","3":"k€"}" + +[exchange] +currency = EUR +currency_round_unit = EUR:0.01 +db = postgres +attribute_encryption_key = "deadbeef" +port = 3434 +bind_to = localhost +master_public_key = "8MQF2XPWCKCW4199JFPE08X7Y9XAX21SF2HD8NZKXM3PY3CMCJ90====" +stefan_abs = EUR:0.00 +stefan_log = EUR:0.00 +stefan_lin = 0.00 +aggregator_idle_sleep_interval = "1 hour" +closer_idle_sleep_interval = "1 hour" +transfer_idle_sleep_interval = "1 hour" +wirewatch_idle_sleep_interval = "1 hour" +signkey_legal_duration = "1 year" +max_keys_caching = "4 weeks" +enable_kyc = NO +terms_etag = "0" +privacy_etag = "0" + +[exchangedb] +idle_reserve_expiration_time = "1 year 2 weeks 3 hours 4 minutes 5 seconds" +legal_reserve_expiration_time = "1 year" +aggregator_shift = "1 year" +max_aml_program_runtime = "1 year" +default_purse_limit = 9999 + +[exchangedb-postgres] +config = "pgx://mte:hunter2@localhost:5432/taler-exchange" + +[taler-exchange-secmod-rsa] +lookahead_sign = "1 year" +overlap_duration = "1 year" + +[taler-exchange-secmod-eddsa] +lookahead_sign = "1 year" +overlap_duration = "1 year" + +[coin_kudo_1] +value= EUR:0.01 +duration_withdraw= "1 year" +duration_spend= "1 year" +duration_legal= "1 year" +fee_withdraw= EUR:0.00 +fee_deposit= EUR:0.00 +fee_refresh= EUR:0.00 +fee_refund= EUR:0.00 +cipher= RSA +rsa_keysize= 2048 +age_restricted= NO + +[coin_kudo_2] +value= EUR:0.02 +duration_withdraw= "1 year" +duration_spend= "1 year" +duration_legal= "1 year" +fee_withdraw= EUR:0.00 +fee_deposit= EUR:0.00 +fee_refresh= EUR:0.00 +fee_refund= EUR:0.00 +cipher= RSA +rsa_keysize= 2048 +age_restricted= NO diff --git a/src/config.ml b/src/config.ml index 64bd756c..992961d6 100644 --- a/src/config.ml +++ b/src/config.ml @@ -1,100 +1,208 @@ -(* hardcoded config for now *) +open Parse_config -let amount s = Amount.of_string s |> Result.get_ok -let zero_eur = amount "EUR:0.00" -let dummy_duration = Ptime.Span.of_int_s 99999999 +let config_data = + let path = Fpath.to_string (Fpath.v "default.config") in + match Assets_crunch.read path with + | None -> Fmt.failwith "static file not found: `%s`" path + | Some data -> + let v = Parse_data.parse data in + (*Fmt.epr "config file:@\n%a@." Pp_debug.pp_config v;*) + v module Exchange = struct - let currency = "EUR" - let currency_round_unit = amount "EUR:0.01" - let db = `Pgx (* plugin to use for the database *) - let attribute_encryption_key = "uhuhg" (* high-entropy nonce. *) - let port = 3434 + let get_opt field = get_opt config_data ~section:"exchange" ~field + let get field = get config_data ~section:"exchange" ~field - let master_public_key = - "8MQF2XPWCKCW4199JFPE08X7Y9XAX21SF2HD8NZKXM3PY3CMCJ90====" - |> B32.decode - |> Result.get_ok - |> Mirage_crypto_ec.Ed25519.pub_of_octets - |> Result.get_ok + (* - *) + 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 stefan_abs = zero_eur - let stefan_log = zero_eur - let stefan_lin = 0.0 - let signkey_legal_duration = dummy_duration - let max_keys_caching = 9999999 - let max_requests = 99999999 - let terms_dir = Fpath.(v "terms") - let terms_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok - let privacy_dir = Fpath.(v "privacy") - let privacy_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok - let enable_kyc = `NO -end + let aggregator_idle_sleep_interval = + get "aggregator_idle_sleep_interval" |> duration -let currency_eur = - Types.Config_types.Currency. - { - enabled= `NO; - code= "EUR"; - name= "euro"; - fractional_input_digits= 2; - fractional_normal_digits= 2; - fractional_trailing_zero_digits= 2; - alt_unit_names= [ (0, "E"); (3, "kE") ]; - } + let closer_idle_sleep_interval = get "closer_idle_sleep_interval" |> duration -module Secmod_rsa = struct - let lookahead_sign = dummy_duration - let overlap_duration = dummy_duration - let sm_priv_key = Fpath.(v "rsa_key.priv") - let key_dir = Fpath.(v "rsa") -end + let transfer_idle_sleep_interval = + get "transfer_idle_sleep_interval" |> duration -module Secmod_eddsa = struct - let lookahead_sign = dummy_duration - let overlap_duration = dummy_duration - let sm_priv_key = Fpath.(v "eddsa_key.priv") - let key_dir = Fpath.(v "eddsa") + 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 + let terms_etag = get "terms_etag" + let privacy_etag = get "privacy_etag" + + (* 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 + privacy_dir *) end module Exchangedb = struct - let idle_reserve_expiration_time = dummy_duration - let legal_reserve_expiration_time = dummy_duration - let aggregator_shift = dummy_duration - let default_purse_limit = 9999 - let max_aml_program_runtime = dummy_duration + let get field = get config_data ~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 module Exchangedb_postgres = struct - (* pgx://:@:/ *) let config = - let user = "mte" in - let password = "hunter2" in - let host = "localhost" in - let port = 5432 in - let database = "taler-exchange" in - Uri.of_string - @@ Fmt.str "pgx://%s:%s@%s:%d/%s" user password host port database + get config_data ~section:"exchangedb-postgres" ~field:"config" |> uri end -let coin_kudo_1 = - Types.Config_types.Coin. +module Currency = struct + type t = { + enabled: [ `YES | `NO ]; + code: string; + name: string; + fractional_input_digits: int; + fractional_normal_digits: int; + fractional_trailing_zero_digits: int; + alt_unit_names: (int * string) list; + } + + let currency_sections = + List.filter + (fun v -> String.starts_with ~prefix:"currency-" v.header) + config_data + + let parse_currency section = + let get field = get config_data ~section:section.header ~field in { - section_name= "kudo_1"; - value= amount "EUR:0.01"; - duration_withdraw= dummy_duration; - duration_spend= dummy_duration; - duration_legal= dummy_duration; - fee_withdraw= zero_eur; - fee_deposit= zero_eur; - fee_refresh= zero_eur; - fee_refund= zero_eur; - cipher= `RSA; - rsa_keysize= 2048; - age_restricted= `NO; + enabled= get "enabled" |> yes_no; + code= get "code"; + name= get "name"; + fractional_input_digits= get "fractional_input_digits" |> int; + fractional_normal_digits= get "fractional_normal_digits" |> int; + fractional_trailing_zero_digits= + get "fractional_trailing_zero_digits" |> int; + alt_unit_names= get "alt_unit_names" |> Parse_alt_unit_names.parse; } -let coin_kudo_2 = - { coin_kudo_1 with section_name= "kudo_2"; value= amount "EUR:0.02" } + let all_currencies = List.map parse_currency currency_sections -let coins = [ coin_kudo_1; coin_kudo_2 ] + (* I think the exchange only handle one currency *) + let v = + match + List.find_opt (fun v -> v.code = Exchange.currency) all_currencies + with + | None -> + fail_with + (Fmt.str + "section `[currency-%s]` not found, currency `%s` is not defined" + Exchange.currency Exchange.currency) + | Some v -> ( + match v.enabled = `YES with + | false -> + fail_with (Fmt.str "currency `%s` is not enabled" Exchange.currency) + | true -> v) +end + +module Coin = struct + type t = { + section_name: string; + value: Amount.t; + duration_withdraw: Ptime.Span.t; + duration_spend: Ptime.Span.t; + duration_legal: Ptime.Span.t; + fee_withdraw: Amount.t; + fee_deposit: Amount.t; + fee_refresh: Amount.t; + fee_refund: Amount.t; + cipher: [ (* `CS |*) `RSA ]; + rsa_keysize: int; (* : int option (only if `RSA) *) + age_restricted: [ (*`YES|*) `NO ]; + } + + let coin_sections = + List.filter + (fun v -> + (* note: here its a '_' not '-' *) + String.starts_with ~prefix:"coin_" v.header) + config_data + + let parse_coin section = + let get field = get config_data ~section:section.header ~field in + let section_name = + String.sub section.header 5 (String.length section.header - 5) + in + { + section_name; + value= get "value" |> amount; + duration_withdraw= get "duration_withdraw" |> duration; + duration_spend= get "duration_spend" |> duration; + duration_legal= get "duration_legal" |> duration; + fee_withdraw= get "fee_withdraw" |> amount; + fee_deposit= get "fee_deposit" |> amount; + fee_refresh= get "fee_refresh" |> amount; + fee_refund= get "fee_refund" |> amount; + cipher= (get "cipher" |> const_value "RSA" |> fun _s -> `RSA); + rsa_keysize= get "rsa_keysize" |> int; + age_restricted= + ( get "age_restricted" |> yes_no |> function + | `NO -> `NO + | `YES -> fail_with "`age_restricted = YES` is not supported" ); + } + + 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 + let get field = + let section = "taler-exchange-secmod-" ^ "rsa" in + get config_data ~section ~field + + let lookahead_sign = get "lookahead_sign" |> duration + let overlap_duration = get "overlap_duration" |> duration + (* not relevant: sm_priv_key key_dir unixpath *) +end + +module Exchange_secmod_eddsa = struct + let get field = + let section = "taler-exchange-secmod-" ^ "eddsa" in + get config_data ~section ~field + + let lookahead_sign = get "lookahead_sign" |> duration + let overlap_duration = get "overlap_duration" |> duration +end diff --git a/src/denomination.ml b/src/denomination.ml index a1e48c0f..5e0a1eb9 100644 --- a/src/denomination.ml +++ b/src/denomination.ml @@ -36,7 +36,7 @@ let make rsa_keysize; age_restricted= _; } : - Config_types.Coin.t) = + Config.Coin.t) = assert (cipher = `RSA); let stamp_start = Ptime_clock.now () in diff --git a/src/devices.ml b/src/devices.ml index a61b563b..5053eada 100644 --- a/src/devices.ml +++ b/src/devices.ml @@ -29,7 +29,7 @@ module Secmod_denom = struct let finally _key = () in Vif.Device.v ~name:"secmod_denom" ~finally [] @@ fun (_env : env) -> let sm_key = Signkey.generate () in - let keys = List.map Denomination.make Config.coins in + let keys = List.map Denomination.make Config.Coin.all_coins in { sm_key; keys } end diff --git a/src/dune b/src/dune index 18668575..db08080e 100644 --- a/src/dune +++ b/src/dune @@ -13,6 +13,7 @@ b32 ; include + parse_config ; caqti caqti-miou diff --git a/src/types.ml b/src/types.ml index a376a10c..4eab7a54 100644 --- a/src/types.ml +++ b/src/types.ml @@ -1,35 +1,3 @@ -module Config_types = struct - module Currency = struct - type t = { - enabled: [ `YES | `NO ]; - code: string; - name: string; - fractional_input_digits: int; - fractional_normal_digits: int; - fractional_trailing_zero_digits: int; - alt_unit_names: (int * string) list; - } - end - - module Coin = struct - type t = { - (* section_name: Name in the configuration file that defines this denomination *) - section_name: string; - value: Amount.t; - duration_withdraw: Ptime.Span.t; - duration_spend: Ptime.Span.t; - duration_legal: Ptime.Span.t; - fee_withdraw: Amount.t; - fee_deposit: Amount.t; - fee_refresh: Amount.t; - fee_refund: Amount.t; - cipher: [ (* `CS |*) `RSA ]; - rsa_keysize: int; (* : int option (only if `RSA) *) - age_restricted: [ (*`YES|*) `NO ]; - } - end -end - module Amount = struct include Amount