diff --git a/default.config b/default.config new file mode 100644 index 00000000..030410fe --- /dev/null +++ b/default.config @@ -0,0 +1,10 @@ +[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 1 +# comment 2 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..b82dbe44 --- /dev/null +++ b/include/parse_config.ml @@ -0,0 +1,142 @@ +(* parse config file + https://docs.taler.net/manpages/taler-exchange.conf.5.html + + do not support "$"-path expansion*) + +(* TODO + - integer + - duration + - YES|NO + - alt_unit_names json pair + +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 + +type item = { + key: string; + value: string; +} + +type section = { + name: string; + items: item list; +} + +type config = section list + +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 >>= function + | None -> fail "peek_char end_of_file failure" + | Some 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 ]) + +let identifier = + let ident_char = function + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true + | _ -> false + in + take_while1 ident_char >>| String.lowercase_ascii + +(* --- Values --- *) + +let value = + let unquoted_value = + take_while1 (fun c -> not (is_whitespace c || is_eol c)) + in + 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 + in + whitespace *> (quoted_value <|> unquoted_value) <* skip_ignored + +let item = + lift2 + (fun key value -> { key; value }) + (identifier <* whitespace <* char '=') + value + +let section_header = char '[' *> identifier <* char ']' + +let section = + lift2 + (fun name items -> { name; items }) + (skip_ignored *> section_header) + (many (skip_ignored *> item)) + +let config : config Angstrom.t = + many_till (section <* skip_ignored) end_of_input + +let parse_config s = + match parse_string ~consume:Consume.All config s with + | Ok v -> v + | Error msg -> failwith msg + +(* --- pp --- *) + +let pp_item ppf { key; value } = + let open Fmt in + pf ppf "%s = %s" key value + +let pp_section ppf (sec : section) = + let open Fmt in + pf ppf "[%s]@\n%a@." sec.name (list ~sep:(any "@\n") pp_item) sec.items + +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" 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