add config parser

default.config

@@ -0,0 +1,17 @@
+# 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"

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,160 @@
+(* 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
+
+module Untyped = struct
+  type item = {
+    key: string;
+    value: string;
+  }
+
+  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
+      | _ -> false
+    in
+    take_while1 ident_char >>| String.lowercase_ascii
+
+  let take_till_end_of_line =
+    take_till is_eol >>= fun s -> return s <* end_of_line
+
+  let blank = whitespace <* end_of_line >>| fun () -> Blank
+
+  let comment =
+    whitespace *> (char '#' <|> char '%') *> take_till_end_of_line >>| fun s ->
+    Comment s
+
+  let header = char '[' *> id <* char ']' <* end_of_line >>| fun s -> Header s
+
+  let item_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 s ->
+      match String.ends_with ~suffix:"\"" s with
+      | false -> fail "invalid quoted value"
+      | true ->
+          let value = String.sub s 0 (String.length s - 1) in
+          return value
+    in
+    quoted_value <|> unquoted_value
+
+  let item =
+    lift2
+      (fun key value -> Item { key; value })
+      id
+      (whitespace *> char '=' *> whitespace *> item_value)
+    <* end_of_line
+
+  let config = many (choice [ blank; comment; header; item ]) <* end_of_input
+
+  let fold_sections l =
+    let rec loop section_l item_l l =
+      match l with
+      | [] ->
+          if List.is_empty item_l then section_l
+          else Fmt.failwith "invalid config structure"
+      | Blank :: tl | Comment _ :: tl -> loop section_l item_l tl
+      | Item item :: tl -> loop section_l (item :: item_l) tl
+      | Header header :: tl ->
+          let section = { header; items= item_l } in
+          loop (section :: section_l) [] tl
+    in
+    loop [] [] (List.rev l)
+
+  let parse s =
+    match parse_string ~consume:All config s with
+    | Error msg -> Fmt.failwith "config 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;
+
+  ()

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