tools/gen_registry_files.ml

@@ -0,0 +1,172 @@
+module Signature_code = struct
+  type t = {
+    number: int32;
+    name: string;
+    comment: string;
+  }
+end
+
+module Error_code = struct
+  type t = {
+    value: int;
+    name: string;
+    description: string;
+    http_status: int;
+  }
+end
+
+let parse_signature_codes records =
+  records
+  |> List.filter_map (fun l ->
+      match l with
+      | a :: b :: c :: _ -> (
+          let open Recfile_parser in
+          match a.k = "Number" && b.k = "Name" && c.k = "Comment" with
+          | false -> None
+          | true ->
+              Some
+                Signature_code.
+                  {
+                    number= Int32.of_int (int_of_string a.v);
+                    name= String.lowercase_ascii b.v;
+                    comment= c.v;
+                  })
+      | _ -> None)
+  |> List.filter (fun v -> v.Signature_code.number >= 1000_l)
+
+let parse_error_codes records =
+  records
+  |> List.filter_map (fun l ->
+      match l with
+      | a :: b :: c :: d :: _ -> (
+          let open Recfile_parser in
+          match
+            a.k = "Value"
+            && b.k = "Name"
+            && c.k = "Description"
+            && d.k = "HttpStatus"
+          with
+          | false -> None
+          | true ->
+              Some
+                Error_code.
+                  {
+                    value= int_of_string a.v;
+                    name= b.v;
+                    description= c.v;
+                    http_status= int_of_string d.v;
+                  })
+      | _ -> None)
+
+let pp_taler_signatures_ml ppf purposes =
+  let header =
+    {|(* This file was generated from the GANA database:
+   https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)|}
+  in
+  let pp ppf Signature_code.{ number; name; comment } =
+    Fmt.pf ppf "(** %s *)\nlet %s : int32 = %ld_l\n\n" comment name number
+  in
+  Fmt.pf ppf "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes;
+  ()
+
+let pp_taler_error_codes_ml ppf purposes =
+  let header =
+    {|(* This file was generated from the GANA database:
+   https://git-www.gnunet.org/gana.git/tree/gnunet-error-codes/registry.rec
+   https://git-www.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *)|}
+  in
+  Fmt.pf ppf
+    "\n\n\
+     type t ={ value: int; name: string; description: string; http_status: int \
+     }\n\n";
+  let pp ppf Error_code.{ value; name; description; http_status } =
+    Fmt.pf ppf
+      {|let %s = { value = %d; name = "%s"; description = "%s"; http_status = %d }\n\n|}
+      (String.lowercase_ascii name)
+      value name description http_status
+  in
+  Fmt.pf ppf "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes;
+  ()
+
+let download ~tmp ~url =
+  let open Bos in
+  let res =
+    OS.Cmd.run
+      Cmd.(
+        v "curl" % "--silent" % "--show-error" % "-o" % tmp % "-X" % "GET" % url)
+  in
+  match res with
+  | Error (`Msg s) -> Fmt.failwith "download failure: %s" s
+  | Ok () -> ()
+
+(* --- *)
+
+let signatures ~output =
+  let url =
+    "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
+  in
+  let tmp_file = Bos.OS.File.tmp "registry.rec.%s" |> Result.get_ok in
+  download ~tmp:(Fpath.to_string tmp_file) ~url;
+  let content = Bos.OS.File.read tmp_file |> Result.get_ok in
+  match Recfile_parser.parse content with
+  | Error msg -> Fmt.failwith "Recfile_parser parse error: %s" msg
+  | Ok records ->
+      let purposes = parse_signature_codes records in
+      let module_content = Fmt.str "%a" pp_taler_signatures_ml purposes in
+      Bos.OS.File.write (Fpath.v output) module_content |> Result.get_ok
+
+let error_codes ~output =
+  let f url =
+    let tmp_file = Bos.OS.File.tmp "registry.rec.%s" |> Result.get_ok in
+    download ~tmp:(Fpath.to_string tmp_file) ~url;
+    let content = Bos.OS.File.read tmp_file |> Result.get_ok in
+    match Recfile_parser.parse content with
+    | Error msg -> Fmt.failwith "Recfile_parser parse error: %s" msg
+    | Ok records -> parse_error_codes records
+  in
+  let url_1 =
+    "https://git-www.gnunet.org/gana.git/plain/gnunet-error-codes/registry.rec"
+  in
+  let url_2 =
+    "https://git-www.gnunet.org/gana.git/plain/gnu-taler-error-codes/registry.rec"
+  in
+  let error_codes = f url_1 @ f url_2 in
+  let module_content = Fmt.str "%a" pp_taler_error_codes_ml error_codes in
+  Bos.OS.File.write (Fpath.v output) module_content |> Result.get_ok
+
+(* --- *)
+open Cmdliner
+open Cmdliner.Term.Syntax
+
+let output =
+  let doc = "output file" in
+  Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
+
+let signatures_cmd =
+  let doc =
+    "Generate taler_signatures.ml from GANA gnunet-signatures registry"
+  in
+  Cmd.make (Cmd.info "signatures" ~doc)
+  @@
+  let+ output = output in
+  signatures ~output
+
+let error_codes_cmd =
+  let doc =
+    "Generate taler_error_codes.ml from GANA gnunet-error-codes and \
+     gnunet-taler-error-codes registries"
+  in
+  Cmd.make (Cmd.info "error_codes" ~doc)
+  @@
+  let+ output = output in
+  error_codes ~output
+
+let cli =
+  let info =
+    let doc = "Tool to generate OCaml module from GANA registries" in
+    Cmd.info "gen_registry_files" ~doc
+  in
+  Cmd.group info [ signatures_cmd; error_codes_cmd ]
+
+let main () = Cmd.eval cli
+let () = if !Sys.interactive then () else exit (main ())