signatures.ml

@@ -0,0 +1,280 @@
+(* This file was generated from the GANA database:
+   https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)
+
+(** Initialize or update the status of an AML key for an AML officer *)
+let master_aml_key : int32 = 1017_l
+
+(** Affirm wiring of exchange profits to operator account. *)
+let master_drain_profit : int32 = 1018_l
+
+(** Signature affirming a partner configuration for wads. *)
+let master_partner_details : int32 = 1019_l
+
+(** The given revocation key was revoked and must no longer be used. *)
+let master_signing_key_revoked : int32 = 1020_l
+
+(** Add payto URI to the list of our wire methods. *)
+let master_add_wire : int32 = 1021_l
+
+(** Signature over global set of fees charged by the exchange. *)
+let master_global_fees : int32 = 1022_l
+
+(** Remove payto URI from the list of our wire methods. *)
+let master_del_wire : int32 = 1023_l
+
+(** Purpose for signing public keys signed by the exchange master key. *)
+let master_signing_key_validity : int32 = 1024_l
+
+(** Purpose for denomination keys signed by the exchange master key. *)
+let master_denomination_key_validity : int32 = 1025_l
+
+(** Add an auditor to the list of our auditors. *)
+let master_add_auditor : int32 = 1026_l
+
+(** Remove an auditor from the list of our auditors. *)
+let master_del_auditor : int32 = 1027_l
+
+(** Fees charged per (aggregate) wire transfer to the merchant. *)
+let master_wire_fees : int32 = 1028_l
+
+(** The given revocation key was revoked and must no longer be used. *)
+let master_denomination_key_revoked : int32 = 1029_l
+
+(** Signature where the Exchange confirms its IBAN details in the /wire
+    response. *)
+let master_wire_details : int32 = 1030_l
+
+(** Set the configuration of an extension (age-restriction or peer2peer) *)
+let master_extension : int32 = 1031_l
+
+(** Purpose for the state of a reserve, signed by the exchange's signing key. *)
+let exchange_reserve_status : int32 = 1032_l
+
+(** Signature where the Exchange confirms a deposit request. *)
+let exchange_confirm_deposit : int32 = 1033_l
+
+(** Signature where the exchange (current signing key) confirms the no-reveal
+    index for cut-and-choose and the validity of the melted coins. *)
+let exchange_confirm_melt : int32 = 1034_l
+
+(** Signature where the Exchange confirms the full /keys response set. *)
+let exchange_key_set : int32 = 1035_l
+
+(** Signature where the Exchange confirms the /track/transaction response. *)
+let exchange_confirm_wire : int32 = 1036_l
+
+(** Signature where the Exchange confirms the /wire/deposit response. *)
+let exchange_confirm_wire_deposit : int32 = 1037_l
+
+(** Signature where the Exchange confirms a refund request. *)
+let exchange_confirm_refund : int32 = 1038_l
+
+(** Signature where the Exchange confirms a recoup. *)
+let exchange_confirm_recoup : int32 = 1039_l
+
+(** Signature where the Exchange confirms it closed a reserve. *)
+let exchange_reserve_closed : int32 = 1040_l
+
+(** Signature where the Exchange confirms a recoup-refresh operation. *)
+let exchange_confirm_recoup_refresh : int32 = 1041_l
+
+(** Signature where the Exchange confirms that it does not know a denomination
+    (hash). *)
+let exchange_affirm_denom_unknown : int32 = 1042_l
+
+(** Signature where the Exchange confirms that it does not consider a
+    denomination valid for the given operation at this time. *)
+let exchange_affirm_denom_expired : int32 = 1043_l
+
+(** Signature by which the exchange affirms that a purse was created with a
+    certain amount deposited into it. *)
+let exchange_confirm_purse_creation : int32 = 1045_l
+
+(** Signature by which the exchange affirms that a purse was merged into a
+    reserve with a certain amount in it. *)
+let exchange_confirm_purse_merged : int32 = 1046_l
+
+(** Purpose for the state of a purse, signed by the exchange's signing key. *)
+let exchange_purse_status : int32 = 1047_l
+
+(** Signature by which the exchange attests identity attributes of a particular
+    reserve owner. *)
+let exchange_reserve_attest_details : int32 = 1048_l
+
+(** Signature by which the exchange confirms that a purse expired and a coin was
+    refunded. *)
+let exchange_confirm_purse_refund : int32 = 1049_l
+
+(** Signature where the Exchange confirms an (age-)withdraw. *)
+let exchange_confirm_withdraw : int32 = 1050_l
+
+(** Signature where the auditor confirms that he is aware of certain
+    denomination keys from the exchange. *)
+let auditor_exchange_keys : int32 = 1064_l
+
+(** Signature where the merchant confirms a contract (to the customer). *)
+let merchant_contract : int32 = 1101_l
+
+(** Signature where the merchant confirms a refund (of a coin). *)
+let merchant_refund : int32 = 1102_l
+
+(** Signature where the merchant confirms that he needs the wire transfer
+    identifier for a deposit operation. *)
+let merchant_track_transaction : int32 = 1103_l
+
+(** Signature where the merchant confirms that the payment was successful *)
+let merchant_payment_ok : int32 = 1104_l
+
+(** Signature where the merchant confirms its own (salted) wire details (not yet
+    really used). *)
+let merchant_wire_details : int32 = 1107_l
+
+(** Signature where the merchant issues a token by blindly signing it. Signed
+    with the token issue private key. *)
+let merchant_token_issue : int32 = 1108_l
+
+(** Signature where the reserve key confirms a withdraw request. Signed with the
+    reserve private key. *)
+let wallet_reserve_withdraw : int32 = 1200_l
+
+(** Signature made by the wallet of a user to confirm a deposit of a coin. *)
+let wallet_coin_deposit : int32 = 1201_l
+
+(** Signature using a coin key confirming the melting of a coin. Signed with the
+    coin's private key. *)
+let wallet_coin_melt : int32 = 1202_l
+
+(** Signature using a coin key requesting recoup. Signed with the coin's private
+    key. *)
+let wallet_coin_recoup : int32 = 1203_l
+
+(** Signature using a coin key authenticating link data. Signed with the old
+    coin's private key. *)
+let wallet_coin_link : int32 = 1204_l
+
+(** Signature using a reserve key by which a wallet requests a payment target
+    UUID for itself. Signs over just a purpose (no body), as the signature only
+    serves to demonstrate that the request comes from the wallet controlling the
+    private key, and not some third party. *)
+let wallet_account_setup : int32 = 1205_l
+
+(** Signature using a coin key requesting recoup-refresh. Signed with the coin
+    private key. *)
+let wallet_coin_recoup_refresh : int32 = 1206_l
+
+(** Signature using a age restriction key for attestation of a particular
+    age/age-group. *)
+let wallet_age_attestation : int32 = 1207_l
+
+(** Request full or partial reserve history. Signed with the reserve private
+    key. *)
+let wallet_reserve_history : int32 = 1208_l
+
+(** Request full or partial coin history. Signed with the coin private key. *)
+let wallet_coin_history : int32 = 1209_l
+
+(** Request purse creation (without reserve). Signed by the purse private key.
+*)
+let wallet_purse_create : int32 = 1210_l
+
+(** Request coin to be deposited into a purse. Signed with the coin private key.
+*)
+let wallet_purse_deposit : int32 = 1211_l
+
+(** Request purse status. Signed with the purse private key. *)
+let wallet_purse_status : int32 = 1212_l
+
+(** Request purse to be merged with a reserve. Signed with the purse private
+    key. *)
+let wallet_purse_merge : int32 = 1213_l
+
+(** Request purse to be merged with a reserve. Signed by the reserve private
+    key. *)
+let wallet_account_merge : int32 = 1214_l
+
+(** Request account to be closed. Signed with the reserve private key. *)
+let wallet_reserve_close : int32 = 1215_l
+
+(** Associates encrypted contract with a purse. Signed with the purse private
+    key. *)
+let wallet_purse_econtract : int32 = 1216_l
+
+(** Request reserve to be kept open. Signed with the reserve private key. *)
+let wallet_reserve_open : int32 = 1217_l
+
+(** Request coin to be used to pay for reserve to be kept open. Signed with the
+    coin private key. *)
+let wallet_reserve_open_deposit : int32 = 1218_l
+
+(** Request attestation about reserve owner. Signed by the reserve private key.
+*)
+let wallet_reserve_attest_details : int32 = 1219_l
+
+(** Signature by which a wallet requests a purse to be deleted. *)
+let wallet_purse_delete : int32 = 1220_l
+
+(** Signature where the reserve key confirms an age-withdraw request. Signed
+    with the reserve private key. *)
+let wallet_reserve_age_withdraw : int32 = 1221_l
+
+(** Signature where the token use key confirms the usage of a token on a pay
+    request. Signed with the token use private key. *)
+let wallet_token_use : int32 = 1222_l
+
+(** Signature used to unclaim an order, allowing other wallets to claim it.
+    Signed with the private key of the claim nonce. *)
+let wallet_order_unclaim : int32 = 1223_l
+
+(** Signature on a denomination key announcement. *)
+let sm_rsa_denomination_key : int32 = 1250_l
+
+(** Signature on an exchange message signing key announcement. *)
+let sm_signing_key : int32 = 1251_l
+
+(** Signature on a denomination key announcement. *)
+let sm_cs_denomination_key : int32 = 1252_l
+
+(** EdDSA test signature. *)
+let client_test_eddsa : int32 = 1302_l
+
+(** EdDSA test signature. *)
+let exchange_test_eddsa : int32 = 1303_l
+
+(** Signature by which an AML officer signs an AML decision. *)
+let aml_decision : int32 = 1350_l
+
+(** Signature by which an AML officer requests AML data. *)
+let aml_query : int32 = 1351_l
+
+(** Signature by which an account owner authorizes access to a KYC operation. *)
+let kyc_auth : int32 = 1360_l
+
+(** EdDSA signature for a policy upload. *)
+let anastasis_policy_upload : int32 = 1400_l
+
+(** EdDSA signature for a backup upload. *)
+let sync_backup_upload : int32 = 1450_l
+
+(** The signature is done by the Donau. The Donau signes over the total amount
+    of the corresponding year, the corresponding year and the donation
+    identifier of a specific donor. The statement confirms that the donor made
+    this total in donations for the given year. *)
+let donau_donation_statement : int32 = 1500_l
+
+(** The signature is made by a charity and shows that the charity is in
+    agreement with the donation request which it sends to the Donau. The charity
+    signs over all blinded identifiers and key pairs which it has received from
+    the donor. The signature affirms that the charity wants the donation
+    receipts to be issued on its behalf. *)
+let charity_donation_confirmation : int32 = 1501_l
+
+(** The signature is made by a charity to request information about its status
+    from a Donau. It is not over anything in particular and is just there for
+    access control. *)
+let charity_get_info : int32 = 1502_l
+
+(** Signature over messages to delete in the mailbox service *)
+let mailbox_messages_delete : int32 = 1551_l
+
+(** Signature for mailbox registration request *)
+let mailbox_register : int32 = 1552_l

tools/dune

@@ -5,12 +5,12 @@
  (libraries cmdliner bos fmt mirage-crypto ptime mte vif))
 
 (executable
- (public_name gen_taler_signatures)
- (name gen_taler_signatures)
- (modules gen_taler_signatures)
+ (public_name gen_registry_files)
+ (name gen_registry_files)
+ (modules gen_registry_files)
  (libraries recfile_parser bos fmt))
 
 (library
  (name recfile_parser)
  (modules recfile_parser)
- (libraries angstrom bos fmt))
+ (libraries angstrom bos cmdliner fmt))

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

tools/gen_taler_signatures.ml

@@ -1,67 +0,0 @@
-type purpose = {
-  number: int32;
-  name: string;
-  comment: string;
-}
-
-let download ~output ~url =
-  let open Bos in
-  let res =
-    OS.Cmd.run
-      Cmd.(
-        v "curl"
-        % "--silent"
-        % "--show-error"
-        % "-o"
-        % output
-        % "-X"
-        % "GET"
-        % url)
-  in
-  match res with
-  | Error (`Msg s) -> Fmt.failwith "download failure: %s" s
-  | Ok () -> ()
-
-let parse_purposes 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
-                {
-                  number= Int32.of_int (int_of_string a.v);
-                  name= String.lowercase_ascii b.v;
-                  comment= c.v;
-                })
-      | _ -> None)
-  |> List.filter (fun v -> v.number >= 1000_l)
-
-let print_module 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 { number; name; comment } =
-    Fmt.pf ppf "(** %s *)\nlet %s : int32 = %ld_l\n\n" comment name number
-  in
-  Fmt.pr "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes;
-  ()
-
-(* --- *)
-
-let url =
-  "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
-
-let main () =
-  let tmp_file = Bos.OS.File.tmp "registry.rec.%s" |> Result.get_ok in
-  download ~output:(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 -> print_module (parse_purposes records)
-
-let () = main ()