add parse_config.ml (buggy)

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

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:
 ;

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;
+
+  ()

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