mte/tools/gen_registry_files.ml

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