diff --git a/signatures.ml b/signatures.ml new file mode 100644 index 00000000..8715b472 --- /dev/null +++ b/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 diff --git a/tools/dune b/tools/dune index 7e06a8ea..7b747b57 100644 --- a/tools/dune +++ b/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)) diff --git a/tools/gen_registry_files.ml b/tools/gen_registry_files.ml new file mode 100644 index 00000000..6ba2ab75 --- /dev/null +++ b/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 ()) diff --git a/tools/gen_taler_signatures.ml b/tools/gen_taler_signatures.ml deleted file mode 100644 index 1b98526a..00000000 --- a/tools/gen_taler_signatures.ml +++ /dev/null @@ -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 ()