diff --git a/default_config.config b/default_config.config new file mode 100644 index 00000000..b3a0ce3b --- /dev/null +++ b/default_config.config @@ -0,0 +1,9 @@ +[currency-EUR] +enabled = NO +code= "EUR" +name =euro +fractional_input_digits = 2 +fractional_normal_digits =2 +fractional_trailing_zero_digits= 2 +alt_unit_names = "{"0":"€","3":"k€"}" + # comment diff --git a/include/dune b/include/dune index df2b6ee1..f5c8787a 100644 --- a/include/dune +++ b/include/dune @@ -9,6 +9,11 @@ (modules gen_taler_signatures) (libraries fmt angstrom)) +(executable + (name parse_config) + (modules parse_config) + (libraries fmt angstrom amount)) + ; 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 new file mode 100644 index 00000000..c303ceca --- /dev/null +++ b/include/parse_config.ml @@ -0,0 +1,152 @@ +(* parse config file + https://docs.taler.net/manpages/taler-exchange.conf.5.html + + do not support "$"-path expansion*) + +[@@@ocaml.warning "-27-69-32"] + +(* +(* --- Duration values --- *) + +type duration_element = { + number: int; + unit_: [ `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 "not an integer" + | Some i -> return i + +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 read_file file = In_channel.with_open_bin file In_channel.input_all + +open Angstrom + +(* --- Utilities --- *) + +let is_whitespace = function ' ' | '\t' -> true | _ -> false +let whitespace = skip_while is_whitespace +let blank_line = whitespace *> end_of_line +let is_eol = function '\n' | '\r' -> true | _ -> false + +let comment = + whitespace *> peek_char_fail >>= fun c -> + if c = '#' || c = '%' then skip_while (fun c -> not (is_eol c)) *> end_of_line + else fail "not a comment" + +let skip_ignored = skip_many (choice [ comment; blank_line ]) + +(* --- Identifiers --- *) + +let ident_char = function + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true + | _ -> false + +let identifier = take_while1 ident_char >>| String.lowercase_ascii + +(* --- Values --- *) + +(* +let quoted_value = + char '"' *> take_till is_eol >>= fun line_rest -> + match String.rindex_opt line_rest '"' with + | None -> fail "unterminated quoted value" + | Some i -> + let value = String.sub line_rest 0 i in + (* consume up to and including the closing quote *) + let len = String.length line_rest in + let remaining_len = len - i - 1 in + advance (len - remaining_len) *> return value + *) + +let unquoted_value = take_while1 (fun c -> not (is_whitespace c || is_eol c)) + +let value = + whitespace + *> + (*quoted_value <|> *) + unquoted_value + <* skip_ignored + +(* --- Option line --- *) + +type option_entry = { + key: string; + value: string; +} + +let option_line = + lift2 + (fun key value -> { key; value }) + (identifier <* whitespace <* char '=') + value + +(* --- Section --- *) + +type section = { + name: string; + options: option_entry list; +} + +let section_header = char '[' *> identifier <* char ']' + +let section_parser = + lift2 + (fun name options -> { name; options }) + (section_header <* skip_ignored) + (many (option_line <* skip_ignored)) + +(* --- Whole config file --- *) + +type config = section list + +let config_parser : config Angstrom.t = + skip_ignored *> many section_parser <* skip_ignored <* end_of_input + +let parse_config s = + match parse_string ~consume:Consume.All config_parser s with + | Ok v -> v + | Error msg -> failwith msg + +(* --- Pretty printer --- *) + +(* Pretty-printer for an option: key = value *) +let pp_option ppf (opt : option_entry) = + let open Fmt in + pf ppf "%s = %s" opt.key opt.value + +(* Pretty-printer for a section *) +let pp_section ppf (sec : section) = + let open Fmt in + pf ppf "[%s]@\n%a@." sec.name (list ~sep:(any "@\n") pp_option) sec.options + +(* Pretty-printer for the entire config *) +let pp_config ppf (cfg : config) = + let open Fmt in + pf ppf "%a@." (list ~sep:(any "@\n") pp_section) cfg + +let () = + let content = read_file "default_config.config" in + (*Fmt.pr "%s@." content;*) + + let config = parse_config content in + + Fmt.pr "%a" pp_config config; + () diff --git a/include/taler_config_type.ml b/include/taler_config_type.ml index 117c0548..925e08b9 100644 --- a/include/taler_config_type.ml +++ b/include/taler_config_type.ml @@ -129,7 +129,7 @@ module type Coin = sig val fee_deposit : amount val fee_refresh : amount val fee_refund : amount - val cipher : [ `CS | `RSA ] + val cipher : [ (* `CS |*) `RSA ] val rsa_keysize : int option (*only if `RSA *) val age_restricted : [ (*`YES|*) `NO ] end