generate taler_signatures.ml from GANA database

include/taler_signatures.ml

@@ -1,78 +1,280 @@
-(* This file was generated by using data and/or code from the GNU Taler project,
+(* This file was generated from the GANA database:
-   under the AGPL-v3 licence.
+   https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)
-   Do not edit it. *)
 
+(** 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
-let mailbox_messages_delete : int32 = 1223_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

@@ -4,4 +4,8 @@
  (modules offline offline_impl offline_sig)
  (libraries cmdliner bos fmt mirage-crypto ptime mte vif))
 
-; todo depends on curl
+(executable
+ (public_name gen_signatures_registry)
+ (name gen_signatures_registry)
+ (modules gen_signatures_registry)
+ (libraries angstrom bos fmt))

tools/gen_signatures_registry.ml

@@ -0,0 +1,108 @@
+(* rudimentary recfile parser
+   https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
+open Angstrom
+
+type field = {
+  k: string;
+  v: string;
+}
+
+type record = field list
+
+let newline = char '\n'
+let is_newline = function '\n' -> true | _ -> false
+
+let field_name =
+  let first_char =
+    satisfy (function 'a' .. 'z' | 'A' .. 'Z' | '%' -> true | _ -> false)
+  in
+  let subsequent_char =
+    satisfy (function
+      | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> true
+      | _ -> false)
+  in
+  lift2
+    (fun hd tl -> String.of_seq (List.to_seq (hd :: tl)))
+    first_char (many subsequent_char)
+
+(* todo handle '\' escape and '+' on next line *)
+let field_value = take_till is_newline <* newline
+
+let field =
+  let blank = satisfy (function ' ' | '\t' -> true | _ -> false) in
+  let blanks = skip_many1 blank in
+  lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value
+
+let blank = newline *> return ()
+let comment = (char '#' *> take_till is_newline <* newline) *> return ()
+let record = many1 field
+
+let records =
+  let sep =
+    (* at least one blank line *)
+    skip_many comment *> blank *> skip_many (comment <|> blank)
+  in
+  sep_by1 sep record
+
+let recfile : record list t =
+  skip_many (comment <|> blank) *> records <* skip_many (comment <|> blank)
+
+let parse s = parse_string ~consume:All recfile s
+
+(* -- *)
+
+let url =
+  "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
+
+let registry_file = "registry.rec"
+
+let download () =
+  let open Bos in
+  let res =
+    OS.Cmd.run Cmd.(v "curl" % "-s" % "-o" % registry_file % "-X" % "GET" % url)
+  in
+  match res with
+  | Error (`Msg s) -> Fmt.failwith "download failure: %s" s
+  | Ok () -> ()
+
+let read_file file = In_channel.with_open_bin file In_channel.input_all
+
+type purpose = {
+  number: int32;
+  name: string;
+  comment: string;
+}
+
+let parse_purposes records =
+  records
+  |> List.filter_map (fun l ->
+      match l with
+      | a :: b :: c :: _ -> (
+          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 () =
+  download ();
+  let content = read_file registry_file in
+  match parse content with
+  | Error msg -> Fmt.failwith "Recfile parse error: %s" msg
+  | Ok records ->
+      let purposes = parse_purposes records in
+      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;
+      ()