generate taler_signatures.ml from GANA database
This commit is contained in:
parent
117f7075bb
commit
e25f11331c
9 changed files with 427 additions and 158 deletions
|
|
@ -1,5 +0,0 @@
|
|||
(library
|
||||
(name include)
|
||||
; (wrapped false)
|
||||
(modules taler_signatures)
|
||||
(libraries))
|
||||
|
|
@ -1,78 +0,0 @@
|
|||
(* This file was generated by using data and/or code from the GNU Taler project,
|
||||
under the AGPL-v3 licence.
|
||||
Do not edit it. *)
|
||||
|
||||
let master_aml_key : int32 = 1017_l
|
||||
let master_drain_profit : int32 = 1018_l
|
||||
let master_partner_details : int32 = 1019_l
|
||||
let master_signing_key_revoked : int32 = 1020_l
|
||||
let master_add_wire : int32 = 1021_l
|
||||
let master_global_fees : int32 = 1022_l
|
||||
let master_del_wire : int32 = 1023_l
|
||||
let master_signing_key_validity : int32 = 1024_l
|
||||
let master_denomination_key_validity : int32 = 1025_l
|
||||
let master_add_auditor : int32 = 1026_l
|
||||
let master_del_auditor : int32 = 1027_l
|
||||
let master_wire_fees : int32 = 1028_l
|
||||
let master_denomination_key_revoked : int32 = 1029_l
|
||||
let master_wire_details : int32 = 1030_l
|
||||
let master_extension : int32 = 1031_l
|
||||
let exchange_reserve_status : int32 = 1032_l
|
||||
let exchange_confirm_deposit : int32 = 1033_l
|
||||
let exchange_confirm_melt : int32 = 1034_l
|
||||
let exchange_key_set : int32 = 1035_l
|
||||
let exchange_confirm_wire : int32 = 1036_l
|
||||
let exchange_confirm_wire_deposit : int32 = 1037_l
|
||||
let exchange_confirm_refund : int32 = 1038_l
|
||||
let exchange_confirm_recoup : int32 = 1039_l
|
||||
let exchange_reserve_closed : int32 = 1040_l
|
||||
let exchange_confirm_recoup_refresh : int32 = 1041_l
|
||||
let exchange_affirm_denom_unknown : int32 = 1042_l
|
||||
let exchange_affirm_denom_expired : int32 = 1043_l
|
||||
let exchange_confirm_purse_creation : int32 = 1045_l
|
||||
let exchange_confirm_purse_merged : int32 = 1046_l
|
||||
let exchange_purse_status : int32 = 1047_l
|
||||
let exchange_reserve_attest_details : int32 = 1048_l
|
||||
let exchange_confirm_purse_refund : int32 = 1049_l
|
||||
let exchange_confirm_withdraw : int32 = 1050_l
|
||||
let auditor_exchange_keys : int32 = 1064_l
|
||||
let merchant_contract : int32 = 1101_l
|
||||
let merchant_refund : int32 = 1102_l
|
||||
let merchant_track_transaction : int32 = 1103_l
|
||||
let merchant_payment_ok : int32 = 1104_l
|
||||
let merchant_wire_details : int32 = 1107_l
|
||||
let merchant_token_issue : int32 = 1108_l
|
||||
let wallet_reserve_withdraw : int32 = 1200_l
|
||||
let wallet_coin_deposit : int32 = 1201_l
|
||||
let wallet_coin_melt : int32 = 1202_l
|
||||
let wallet_coin_recoup : int32 = 1203_l
|
||||
let wallet_coin_link : int32 = 1204_l
|
||||
let wallet_account_setup : int32 = 1205_l
|
||||
let wallet_coin_recoup_refresh : int32 = 1206_l
|
||||
let wallet_age_attestation : int32 = 1207_l
|
||||
let wallet_reserve_history : int32 = 1208_l
|
||||
let wallet_coin_history : int32 = 1209_l
|
||||
let wallet_purse_create : int32 = 1210_l
|
||||
let wallet_purse_deposit : int32 = 1211_l
|
||||
let wallet_purse_status : int32 = 1212_l
|
||||
let wallet_purse_merge : int32 = 1213_l
|
||||
let wallet_account_merge : int32 = 1214_l
|
||||
let wallet_reserve_close : int32 = 1215_l
|
||||
let wallet_purse_econtract : int32 = 1216_l
|
||||
let wallet_reserve_open : int32 = 1217_l
|
||||
let wallet_reserve_open_deposit : int32 = 1218_l
|
||||
let wallet_reserve_attest_details : int32 = 1219_l
|
||||
let wallet_purse_delete : int32 = 1220_l
|
||||
let wallet_reserve_age_withdraw : int32 = 1221_l
|
||||
let wallet_token_use : int32 = 1222_l
|
||||
let mailbox_messages_delete : int32 = 1223_l
|
||||
let sm_rsa_denomination_key : int32 = 1250_l
|
||||
let sm_signing_key : int32 = 1251_l
|
||||
let sm_cs_denomination_key : int32 = 1252_l
|
||||
let client_test_eddsa : int32 = 1302_l
|
||||
let exchange_test_eddsa : int32 = 1303_l
|
||||
let aml_decision : int32 = 1350_l
|
||||
let aml_query : int32 = 1351_l
|
||||
let kyc_auth : int32 = 1360_l
|
||||
let anastasis_policy_upload : int32 = 1400_l
|
||||
let sync_backup_upload : int32 = 1450_l
|
||||
|
|
@ -5,7 +5,7 @@ let config_data =
|
|||
match Assets_crunch.read path with
|
||||
| None -> fail "static file not found: `%s`" path
|
||||
| Some data ->
|
||||
let v = Parse_data.parse data in
|
||||
let v = Config_section.parse data in
|
||||
v
|
||||
|
||||
module Exchange = struct
|
||||
|
|
@ -109,7 +109,7 @@ module Currency = struct
|
|||
fractional_trailing_zero_digits=
|
||||
get "fractional_trailing_zero_digits" |> int;
|
||||
alt_unit_names=
|
||||
get "alt_unit_names" |> Alt_unit_names.decode |> Parse_config.unwrap_res;
|
||||
get "alt_unit_names" |> Alt_unit_names.decode |> Parse_config.unwrap;
|
||||
}
|
||||
|
||||
let all_currencies = List.map parse_currency currency_sections
|
||||
|
|
|
|||
1
src/dune
1
src/dune
|
|
@ -10,7 +10,6 @@
|
|||
(modules :standard \ mte b32)
|
||||
(libraries
|
||||
b32
|
||||
include
|
||||
;
|
||||
caqti
|
||||
caqti-miou
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
(* parse config file
|
||||
(* rudimentary configuration file parser (INI-like)
|
||||
https://docs.taler.net/manpages/taler-exchange.conf.5.html
|
||||
|
||||
do not support "$"-path expansion *)
|
||||
|
|
@ -21,10 +21,10 @@ let fail fmt =
|
|||
|
||||
let is_eol = function '\n' | '\r' -> true | _ -> false
|
||||
let is_whitespace = function ' ' | '\t' -> true | _ -> false
|
||||
let whitespace = skip_while is_whitespace
|
||||
let blanks = skip_while is_whitespace
|
||||
|
||||
module Parse_data = struct
|
||||
type line =
|
||||
module Config_section = struct
|
||||
type t =
|
||||
| Blank
|
||||
| Comment of string
|
||||
| Header of string
|
||||
|
|
@ -37,24 +37,23 @@ module Parse_data = struct
|
|||
in
|
||||
take_while1 ident_char >>| String.lowercase_ascii
|
||||
|
||||
let take_till_end_of_line =
|
||||
take_till is_eol >>= fun s -> return s <* end_of_line
|
||||
let line = take_till is_eol <* end_of_line
|
||||
let blank_line = blanks <* end_of_line >>| fun () -> Blank
|
||||
let comment = blanks *> (char '#' <|> char '%') *> line >>| fun s -> Comment s
|
||||
|
||||
let blank = whitespace <* end_of_line >>| fun () -> Blank
|
||||
|
||||
let comment =
|
||||
whitespace *> (char '#' <|> char '%') *> take_till_end_of_line >>| fun s ->
|
||||
Comment s
|
||||
|
||||
let header = char '[' *> id <* char ']' <* end_of_line >>| fun s -> Header s
|
||||
let header =
|
||||
blanks *> char '[' *> id <* char ']' <* blanks <* end_of_line >>| fun s ->
|
||||
Header s
|
||||
|
||||
let item_value =
|
||||
let unquoted_value =
|
||||
take_while1 (fun c -> not (is_whitespace c || is_eol c))
|
||||
<* blanks
|
||||
<* end_of_line
|
||||
in
|
||||
let quoted_value =
|
||||
char '"' *> take_till is_eol >>= fun s ->
|
||||
match String.ends_with ~suffix:"\"" s with
|
||||
char '"' *> take_till is_eol <* end_of_line >>= fun s ->
|
||||
match String.ends_with ~suffix:"\"" s && s <> "\"" with
|
||||
| false -> fail "invalid quoted value"
|
||||
| true ->
|
||||
let value = String.sub s 0 (String.length s - 1) in
|
||||
|
|
@ -66,10 +65,10 @@ module Parse_data = struct
|
|||
lift2
|
||||
(fun key value -> Item { key; value })
|
||||
id
|
||||
(whitespace *> char '=' *> whitespace *> item_value)
|
||||
<* end_of_line
|
||||
(blanks *> char '=' *> blanks *> item_value)
|
||||
|
||||
let config = many (choice [ blank; comment; header; item ]) <* end_of_input
|
||||
let config =
|
||||
many (choice [ blank_line; comment; header; item ]) <* end_of_input
|
||||
|
||||
let fold_sections l =
|
||||
let rec loop section_l item_l l =
|
||||
|
|
@ -91,37 +90,7 @@ module Parse_data = struct
|
|||
| Ok v -> fold_sections v
|
||||
end
|
||||
|
||||
module Pp_debug = struct
|
||||
let pp_item ppf { key; value } =
|
||||
let open Fmt in
|
||||
match String.contains value '"' || String.contains value ' ' with
|
||||
| false -> pf ppf "%s = %s" key value
|
||||
| true -> pf ppf "%s = \"%s\"" key value
|
||||
|
||||
let pp_line ppf line =
|
||||
let open Fmt in
|
||||
let open Parse_data in
|
||||
match line with
|
||||
| Blank -> Fmt.nop ppf ()
|
||||
| Comment s -> pf ppf "#%s" s
|
||||
| Header s -> pf ppf "[%s]" s
|
||||
| Item item -> pf ppf "%a" pp_item item
|
||||
|
||||
let _pp_lines ppf raw_line_l =
|
||||
let open Fmt in
|
||||
pf ppf "%a" (list ~sep:(any "\n") pp_line) raw_line_l
|
||||
|
||||
let pp_section ppf { header; items } =
|
||||
let open Fmt in
|
||||
pf ppf "[%s]@\n%a" header (list ~sep:(any "\n") pp_item) items
|
||||
|
||||
let pp_config ppf l =
|
||||
let open Fmt in
|
||||
pf ppf "%a" (list ~sep:(any "\n") pp_section) l
|
||||
end
|
||||
[@@ocaml.warning "-32"]
|
||||
|
||||
module Parse_duration = struct
|
||||
module Config_duration = struct
|
||||
type duration_element = {
|
||||
number: int;
|
||||
dunit: [ `Year | `Week | `Day | `Hour | `Minute | `Second ];
|
||||
|
|
@ -134,9 +103,9 @@ module Parse_duration = struct
|
|||
| Some i -> return i
|
||||
|
||||
let duration_element =
|
||||
let number = whitespace *> integer in
|
||||
let number = blanks *> integer in
|
||||
let dunit =
|
||||
whitespace *> take_while1 (fun c -> not (is_whitespace c || is_eol c))
|
||||
blanks *> take_while1 (fun c -> not (is_whitespace c || is_eol c))
|
||||
>>= function
|
||||
| "year" | "years" -> return `Year
|
||||
| "week" | "weeks" -> return `Week
|
||||
|
|
@ -162,20 +131,12 @@ module Parse_duration = struct
|
|||
in
|
||||
f u
|
||||
|
||||
let ptime_span_of_int64 i =
|
||||
match Ptime.Span.of_float_s (Int64.to_float i) with
|
||||
| None ->
|
||||
fail "ptime_span_of_int64 error: `%Ld` is not a valid ptime span" i
|
||||
| Some ts -> ts
|
||||
|
||||
let to_time_span t =
|
||||
let acc =
|
||||
List.fold_left
|
||||
(fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit))
|
||||
0 t
|
||||
in
|
||||
let acc = Int64.of_int acc in
|
||||
Time.Relative.of_s acc
|
||||
|> Int64.of_int
|
||||
|> Time.Relative.of_s
|
||||
|
||||
let parse s : duration_element list =
|
||||
match parse_string ~consume:All duration s with
|
||||
|
|
@ -183,7 +144,7 @@ module Parse_duration = struct
|
|||
| Ok v -> v
|
||||
end
|
||||
|
||||
let unwrap_res = function Error e -> fail "`%s`." e | Ok v -> v
|
||||
let unwrap = function Error e -> fail "`%s`." e | Ok v -> v
|
||||
|
||||
let get_opt t ~section ~field =
|
||||
match List.find_opt (fun v -> v.header = section) t with
|
||||
|
|
@ -217,16 +178,16 @@ let yes_no = function
|
|||
| s -> fail "expected `YES`/`NO` value, got `%s`" s
|
||||
|
||||
let uri s = Uri.of_string s
|
||||
let amount s = s |> Amount.of_string |> unwrap_res
|
||||
let duration s = Parse_duration.(s |> parse |> to_time_span)
|
||||
let amount s = s |> Amount.of_string |> unwrap
|
||||
let duration s = Config_duration.(s |> parse |> to_time_span)
|
||||
|
||||
let ed25519 s =
|
||||
s
|
||||
|> B32.decode
|
||||
|> unwrap_res
|
||||
|> unwrap
|
||||
|> Mirage_crypto_ec.Ed25519.pub_of_octets
|
||||
|> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
|
||||
|> unwrap_res
|
||||
|> unwrap
|
||||
|
||||
(* TODO
|
||||
move to another module
|
||||
|
|
|
|||
|
|
@ -4,7 +4,6 @@
|
|||
|
||||
can we skip defining a specific record for signatures and directly use Api records? *)
|
||||
open Hash
|
||||
module Taler_signatures = Include.Taler_signatures
|
||||
|
||||
module Aliases = struct
|
||||
module Timestamp = struct
|
||||
|
|
|
|||
280
src/taler_signatures.ml
Normal file
280
src/taler_signatures.ml
Normal file
|
|
@ -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
|
||||
|
|
@ -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))
|
||||
|
|
|
|||
109
tools/gen_signatures_registry.ml
Normal file
109
tools/gen_signatures_registry.ml
Normal file
|
|
@ -0,0 +1,109 @@
|
|||
module Recfile = struct
|
||||
(* 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
|
||||
end
|
||||
|
||||
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 :: _ -> (
|
||||
let open Recfile 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 () =
|
||||
download ();
|
||||
let content = read_file registry_file in
|
||||
match Recfile.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;
|
||||
()
|
||||
Loading…
Add table
Add a link
Reference in a new issue