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

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