JJ: Description from the destination commit:

better config: parse file + crunch

JJ: Description from source commit:
rm taler_config_type.ml
This commit is contained in:
swrup 2025-11-20 18:38:01 +01:00
parent e2d3986989
commit 26a1c0f835
12 changed files with 481 additions and 409 deletions

View file

@ -1,17 +0,0 @@
# comment 1
# foo
# barr
[currency-EUR]
enabled = NO
# comment 2
code= "EUR"
name =euro
fractional_input_digits = 2
fractional_normal_digits =2
fractional_trailing_zero_digits= 2
% comment 3
alt_unit_names = "{"0":"€","3":"k€"}"
% comment 4
[dummy-section]
dummy = "blah"

View file

@ -14,10 +14,10 @@
(modules gen_eddsa_key) (modules gen_eddsa_key)
(libraries fmt mirage-crypto-rng.unix mirage-crypto-ec b32)) (libraries fmt mirage-crypto-rng.unix mirage-crypto-ec b32))
(executable (library ; todo: should I have a /lib?
(name parse_config) (name parse_config)
(modules parse_config) (modules parse_config)
(libraries fmt angstrom amount)) (libraries mirage-crypto-ec ptime fmt angstrom uri amount b32))
; we prefer to generate taler_signatures.ml once, ; we prefer to generate taler_signatures.ml once,
; and commit it, for versionning: ; and commit it, for versionning:

View file

@ -3,64 +3,33 @@
do not support "$"-path expansion*) do not support "$"-path expansion*)
(* TODO open Angstrom
- integer
- duration
- YES|NO
- alt_unit_names json pair
type duration_element = {
number: int;
unit_: [ `Year | `Week | `Day | `Hour | `Minute | `Second ];
}
let integer =
take_while1 (function '0' .. '9' -> true | _ -> false) >>= fun s ->
match int_of_string_opt s with
| None -> fail "not an integer"
| Some i -> return i
let duration_value =
let number = whitespace *> integer in
let unit =
whitespace *> take_while1 (fun c -> not (is_whitespace c || is_eol c))
>>= function
| "year" | "years" -> return `Year
| "week" | "weeks" -> return `Week
| "day" | "days" -> return `Day
| "hour" | "hours" -> return `Hour
| "minute" | "minutes" -> return `Minute
| "s" -> return `Second
| _ -> fail "not a valid duration unit"
in
many1 (lift2 (fun number unit_ -> { number; unit_ }) number unit)
*)
let read_file file = In_channel.with_open_bin file In_channel.input_all
module Untyped = struct
type item = { type item = {
key: string; key: string;
value: string; value: string;
} }
type line =
| Blank
| Comment of string
| Header of string
| Item of item
type section = { type section = {
header: string; header: string;
items: item list; items: item list;
} }
open Angstrom let fail_with msg =
Fmt.epr "Configuration failure: %s.@." msg;
exit 1
let is_eol = function '\n' | '\r' -> true | _ -> false let is_eol = function '\n' | '\r' -> true | _ -> false
let is_whitespace = function ' ' | '\t' -> true | _ -> false let is_whitespace = function ' ' | '\t' -> true | _ -> false
let whitespace = skip_while is_whitespace let whitespace = skip_while is_whitespace
module Parse_data = struct
type line =
| Blank
| Comment of string
| Header of string
| Item of item
let id = let id =
let ident_char = function let ident_char = function
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
@ -86,7 +55,7 @@ module Untyped = struct
let quoted_value = let quoted_value =
char '"' *> take_till is_eol >>= fun s -> char '"' *> take_till is_eol >>= fun s ->
match String.ends_with ~suffix:"\"" s with match String.ends_with ~suffix:"\"" s with
| false -> fail "invalid quoted value" | false -> fail_with "invalid quoted value"
| true -> | true ->
let value = String.sub s 0 (String.length s - 1) in let value = String.sub s 0 (String.length s - 1) in
return value return value
@ -107,7 +76,7 @@ module Untyped = struct
match l with match l with
| [] -> | [] ->
if List.is_empty item_l then section_l if List.is_empty item_l then section_l
else Fmt.failwith "invalid config structure" else fail_with "invalid configuration structure"
| Blank :: tl | Comment _ :: tl -> loop section_l item_l tl | Blank :: tl | Comment _ :: tl -> loop section_l item_l tl
| Item item :: tl -> loop section_l (item :: item_l) tl | Item item :: tl -> loop section_l (item :: item_l) tl
| Header header :: tl -> | Header header :: tl ->
@ -118,8 +87,9 @@ module Untyped = struct
let parse s = let parse s =
match parse_string ~consume:All config s with match parse_string ~consume:All config s with
| Error msg -> Fmt.failwith "config parse error: %s" msg | Error msg -> fail_with (Fmt.str "parse error `%s`" msg)
| Ok v -> fold_sections v | Ok v -> fold_sections v
end
module Pp_debug = struct module Pp_debug = struct
let pp_item ppf { key; value } = let pp_item ppf { key; value } =
@ -130,6 +100,7 @@ module Untyped = struct
let pp_line ppf line = let pp_line ppf line =
let open Fmt in let open Fmt in
let open Parse_data in
match line with match line with
| Blank -> Fmt.nop ppf () | Blank -> Fmt.nop ppf ()
| Comment s -> pf ppf "#%s" s | Comment s -> pf ppf "#%s" s
@ -148,13 +119,158 @@ module Untyped = struct
let open Fmt in let open Fmt in
pf ppf "%a" (list ~sep:(any "\n") pp_section) l pf ppf "%a" (list ~sep:(any "\n") pp_section) l
end end
[@@ocaml.warning "-32"]
module Parse_duration = struct
type duration_element = {
number: int;
dunit: [ `Year | `Week | `Day | `Hour | `Minute | `Second ];
}
let integer =
take_while1 (function '0' .. '9' -> true | _ -> false) >>= fun s ->
match int_of_string_opt s with
| None -> fail_with (Fmt.str "expected integer, got `%s`" s)
| Some i -> return i
let duration_element =
let number = whitespace *> integer in
let dunit =
whitespace *> take_while1 (fun c -> not (is_whitespace c || is_eol c))
>>= function
| "year" | "years" -> return `Year
| "week" | "weeks" -> return `Week
| "day" | "days" -> return `Day
| "hour" | "hours" -> return `Hour
| "minute" | "minutes" -> return `Minute
| "second" | "seconds" | "s" -> return `Second
| s -> fail_with (Fmt.str "expected a duration unit, got `%s`" s)
in
lift2 (fun number dunit -> { number; dunit }) number dunit
let duration = many1 duration_element <* end_of_input
let dunit_to_seconds u =
let rec f = function
| `Year -> 365 * f `Day
| `Week -> 7 * f `Day
| `Day -> 24 * f `Hour
| `Hour -> 60 * f `Minute
| `Minute -> 60 * f `Second
| `Second -> 1
in
f u
let ptime_span_of_int64 i =
match Ptime.Span.of_float_s (Int64.to_float i) with
| None ->
fail_with
(Fmt.str "ptime_span_of_int64 error: `%Ld` is not a valid ptime span"
i)
| Some ts -> ts
let to_ptime_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
let ptime = ptime_span_of_int64 acc in
ptime
let parse s : duration_element list =
match parse_string ~consume:All duration s with
| Error msg -> fail_with (Fmt.str "duration parse error `%s`" msg)
| Ok v -> v
end end
let () = let unwrap_res = function Error e -> fail_with (Fmt.str "`%s`." e) | Ok v -> v
let content = read_file "default.config" in
(*Fmt.pr "%s" content;*)
let config = Untyped.parse content in
(*Fmt.pr "%a@." pp_lines config;*)
Fmt.pr "%a@." Untyped.Pp_debug.pp_config config;
() let get_opt t ~section ~field =
match List.find_opt (fun v -> v.header = section) t with
| None -> None
| Some v -> (
match List.find_opt (fun item -> item.key = field) v.items with
| None -> None
| Some item -> Some item.value)
let get t ~section ~field =
match get_opt t ~section ~field with
| None -> fail_with (Fmt.str "option `[%s].%s` not found" section field)
| Some v -> v
let int s =
match int_of_string_opt s with
| None -> fail_with (Fmt.str "expected int value, got `%s`" s)
| Some v -> v
let float s =
match float_of_string_opt s with
| None -> fail_with (Fmt.str "expected float value, got `%s`" s)
| Some v -> v
let const_value a b =
match a = b with
| false -> fail_with (Fmt.str "unexpected value `%s`" b)
| true -> a
let yes_no = function
| "NO" -> `NO
| "YES" -> `YES
| s -> fail_with (Fmt.str "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_ptime_span)
let ed25519 s =
s
|> B32.decode
|> unwrap_res
|> Mirage_crypto_ec.Ed25519.pub_of_octets
|> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
|> unwrap_res
module Parse_alt_unit_names = struct
let rm_brackets s =
let s = String.trim s in
match
String.starts_with ~prefix:"{" s && String.ends_with ~suffix:"}" s
with
| false -> fail_with (Fmt.str "expected json, got `%s`" s)
| true ->
let s = String.sub s 1 (String.length s - 2) in
s
let rm_quotes s =
let s = String.trim s in
match
String.starts_with ~prefix:"\"" s && String.ends_with ~suffix:"\"" s
with
| false -> fail_with (Fmt.str "expected quoted string, got `%s`" s)
| true ->
let s = String.sub s 1 (String.length s - 2) in
s
let parse s =
let s = rm_brackets s in
String.split_on_char ',' s
|> List.map (String.split_on_char ':')
|> List.map (function
| [ k; v ] -> (k, v)
| _ -> fail_with "invalid json key-value map")
|> List.map (fun (k, v) ->
let k = rm_quotes k in
let v = rm_quotes v in
let k =
match int_of_string_opt k with
| None ->
fail_with
(Fmt.str
"invalid json key-value map, expected integer key, got `%s`"
k)
| Some k -> k
in
(k, v))
end

View file

@ -1,175 +0,0 @@
(* https://docs.taler.net/manpages/taler-exchange.conf.5.html
taler-docs/manpages/taler-exchange.conf.5.rst *)
(* TODO
- generate `config.ml` from config file (virtual module)?
- parse config file format
- no relative path
- default config
- better types
- impl duration
*)
(* TODO unikernel *)
type dir_path
type file_path
(* TODO *)
(* Values that represent a time duration are represented as a series of one or more NUMBER UNIT pairs, e.g. 60 s, 4 weeks 1 day, 5 years 2 minutes. *)
type duration
(* TODO
make it Amount.t *)
type amount = string
type payto_uri = string
(* TODO
still need to parse them and tell that its not supported
some maybe are relevant
idk *)
type not_relevant
type url = string
type seconds = int
(* not relevant for mirage *)
(* this contains path that can be referenced in other with $PATH
(unsupported) *)
module type Global = sig
val taler_home : dir_path
val taler_data_home : dir_path
val taler_config_home : dir_path
val taler_cache_home : dir_path
val taler_runtime_dir : dir_path
end
(* sections "[currency-$NAME]"
see DD51 *)
module type Currency = sig
val enabled : [ `YES | `NO ]
val code : string
val name : string
val fractional_input_digits : int
val fractional_normal_digits : int
val fractional_trailing_zero_digits : int
val alt_unit_names : (int * string) list
end
(* section "[exchange]" *)
module type Exchange = sig
val currency : string
val currency_round_unit : amount
val db : string
val attribute_encryption_key : string
val serve : [ `Unix | `Tcp | `Systemd ]
val unixpath : file_path
val unixpath_mode : int
val port : int
val bind_to : string
val master_public_key : string
val tiny_amount : amount option
val shopping_url : url option
val open_banking_gateway_url : url option
val aml_spa_dialect : string option
val bank_compliance_language : string option
val stefan_abs : amount
val stefan_log : amount
val stefan_lin : float
val base_url : url
val toplevel_redirect_url : string option
val aggregator_idle_sleep_interval : seconds
val closer_idle_sleep_interval : seconds
val transfer_idle_sleep_interval : seconds
val wirewatch_idle_sleep_interval : seconds
val aggregator_shard_size : int option
val signkey_legal_duration : duration
val max_keys_caching : duration
val max_requests : int
val terms_dir : dir_path
val terms_etag : string
val privacy_dir : dir_path
val privacy_etag : string
val enable_kyc : [ `YES | `NO ]
end
(* section "[taler-exchange-secmod-{rsa|cs|eddsa}]". *)
module type Secmod = sig
val lookahead_sign : duration
val overlap_duration : duration
val sm_priv_key : file_path
val key_dir : dir_path
val unixpath : not_relevant
end
module type Secmod_rsa = Secmod
module type Secmod_cs = Secmod
module type Secmod_eddsa = Secmod
(* TODO config
what is the time/duration unit used here? *)
(* section "[exchangedb]". *)
module type Database = sig
val idle_reserve_expiration_time : seconds
val legal_reserve_expiration_time : seconds
val aggregator_shift : seconds
val default_purse_limit : int
val max_aml_program_runtime : int option
module type Postgres_backend = sig
val config : string
end
end
(* sections "[coin_XXX]"
used by secmods *)
module type Coin = sig
val value : amount
val duration_withdraw : duration
val duration_spend : duration
val duration_legal : duration
val fee_withdraw : amount
val fee_deposit : amount
val fee_refresh : amount
val fee_refund : amount
val cipher : [ (* `CS |*) `RSA ]
val rsa_keysize : int option (*only if `RSA *)
val age_restricted : [ (*`YES|*) `NO ]
end
(* sections "[exchange-account-XXX]" *)
module type Account = sig
val payto_uri : payto_uri
val enable_debit : [ `YES | `NO ]
val enable_credit : [ `YES | `NO ]
end
(* sections "[exchange-accountcredentials-XXX]"
must exists for each "[exchange-account-XXX]" section
! credentials to access the bank account
should be in a secret configuration file
only redable for `taler-exchange-wirewatch` `taler-exchange-transfer` processes *)
module type Account_secret = sig
val wire_gateway_url : url
val wire_gateway_auth_method : string
val username : string
val password : string
val token : string
end
(* section "[exchange-extension-<extensionname>]" *)
module type Extensions = sig
val enabled : [ (*`YES|*) `NO ]
end
(* section "[exchange-offline]". *)
module type Offline_signing = sig
val master_priv_file : file_path
(* TODO
- we need two different file here
- there is three, not two, crypto helper modules
is it only two, because the eddsa one is not comptabilized as a "crypto helper" here? *)
(* tofu = Trust On First Use *)
val secm_tofu_file : file_path
val secm_denom_pubkey : string option
val secm_esign_pubkey : string option
end

View file

@ -35,19 +35,15 @@ let make ~sign ~currency ~value ~fraction =
in in
Ok { sign; currency; value; fraction } Ok { sign; currency; value; fraction }
let to_string =
let pp = let pp =
let open Fmt in let open Fmt in
let pp_sign ppf = function let pp_sign ppf = function `Plus -> char ppf '+' | `Minus -> char ppf '-' in
| `Plus -> char ppf '+'
| `Minus -> char ppf '-'
in
let pp_currency ppf = function `Eur -> string ppf "EUR" in let pp_currency ppf = function `Eur -> string ppf "EUR" in
fun ppf { sign; currency; value; fraction } -> fun ppf { sign; currency; value; fraction } ->
pf ppf "%a%a:%Ld.%02ld" (Fmt.option pp_sign) sign pp_currency currency pf ppf "%a%a:%Ld.%02ld" (Fmt.option pp_sign) sign pp_currency currency value
value fraction fraction
in
Fmt.str "%a" pp let to_string = Fmt.str "%a" pp
let of_string = let of_string =
let open Angstrom in let open Angstrom in

View file

@ -51,21 +51,23 @@ module Mimetype = struct
let pp_mime fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime) let pp_mime fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
end end
(* TODO config *)
type t = type t =
| Terms | Terms
| Privacy | Privacy
let etag = function let etag k =
| Terms -> Config.Exchange.terms_etag Result.get_ok
| Privacy -> Config.Exchange.privacy_etag @@ Headers_lib.Etag.of_crockford32
@@ match k with Terms -> "0" | Privacy -> "0"
let legal_version = function let legal_version = function
| Terms -> terms_legal_version | Terms -> terms_legal_version
| Privacy -> privacy_legal_version | Privacy -> privacy_legal_version
let base_dir = function let base_dir = function
| Terms -> Config.Exchange.terms_dir | Terms -> Fpath.v "terms"
| Privacy -> Config.Exchange.privacy_dir | Privacy -> Fpath.v "privacy"
(* TODO (* TODO
better use of Fmt to have error prefix or smthing better use of Fmt to have error prefix or smthing

73
src/assets/default.config Normal file
View file

@ -0,0 +1,73 @@
[currency-EUR]
enabled= YES
code= EUR
name= euro
fractional_input_digits= 2
fractional_normal_digits= 2
fractional_trailing_zero_digits= 2
alt_unit_names= "{"0":"€","3":"k€"}"
[exchange]
currency = EUR
currency_round_unit = EUR:0.01
db = postgres
attribute_encryption_key = "deadbeef"
port = 3434
bind_to = localhost
master_public_key = "8MQF2XPWCKCW4199JFPE08X7Y9XAX21SF2HD8NZKXM3PY3CMCJ90===="
stefan_abs = EUR:0.00
stefan_log = EUR:0.00
stefan_lin = 0.00
aggregator_idle_sleep_interval = "1 hour"
closer_idle_sleep_interval = "1 hour"
transfer_idle_sleep_interval = "1 hour"
wirewatch_idle_sleep_interval = "1 hour"
signkey_legal_duration = "1 year"
max_keys_caching = "4 weeks"
enable_kyc = NO
terms_etag = "0"
privacy_etag = "0"
[exchangedb]
idle_reserve_expiration_time = "1 year 2 weeks 3 hours 4 minutes 5 seconds"
legal_reserve_expiration_time = "1 year"
aggregator_shift = "1 year"
max_aml_program_runtime = "1 year"
default_purse_limit = 9999
[exchangedb-postgres]
config = "pgx://mte:hunter2@localhost:5432/taler-exchange"
[taler-exchange-secmod-rsa]
lookahead_sign = "1 year"
overlap_duration = "1 year"
[taler-exchange-secmod-eddsa]
lookahead_sign = "1 year"
overlap_duration = "1 year"
[coin_kudo_1]
value= EUR:0.01
duration_withdraw= "1 year"
duration_spend= "1 year"
duration_legal= "1 year"
fee_withdraw= EUR:0.00
fee_deposit= EUR:0.00
fee_refresh= EUR:0.00
fee_refund= EUR:0.00
cipher= RSA
rsa_keysize= 2048
age_restricted= NO
[coin_kudo_2]
value= EUR:0.02
duration_withdraw= "1 year"
duration_spend= "1 year"
duration_legal= "1 year"
fee_withdraw= EUR:0.00
fee_deposit= EUR:0.00
fee_refresh= EUR:0.00
fee_refund= EUR:0.00
cipher= RSA
rsa_keysize= 2048
age_restricted= NO

View file

@ -1,100 +1,208 @@
(* hardcoded config for now *) open Parse_config
let amount s = Amount.of_string s |> Result.get_ok let config_data =
let zero_eur = amount "EUR:0.00" let path = Fpath.to_string (Fpath.v "default.config") in
let dummy_duration = Ptime.Span.of_int_s 99999999 match Assets_crunch.read path with
| None -> Fmt.failwith "static file not found: `%s`" path
| Some data ->
let v = Parse_data.parse data in
(*Fmt.epr "config file:@\n%a@." Pp_debug.pp_config v;*)
v
module Exchange = struct module Exchange = struct
let currency = "EUR" let get_opt field = get_opt config_data ~section:"exchange" ~field
let currency_round_unit = amount "EUR:0.01" let get field = get config_data ~section:"exchange" ~field
let db = `Pgx (* plugin to use for the database *)
let attribute_encryption_key = "uhuhg" (* high-entropy nonce. *)
let port = 3434
let master_public_key = (* - *)
"8MQF2XPWCKCW4199JFPE08X7Y9XAX21SF2HD8NZKXM3PY3CMCJ90====" let currency = (* todo: constraint on currency string *) get "currency"
|> B32.decode let currency_round_unit = get "currency_round_unit" |> amount
|> Result.get_ok let db = get "db" |> const_value "postgres"
|> Mirage_crypto_ec.Ed25519.pub_of_octets let attribute_encryption_key = get "attribute_encryption_key"
|> Result.get_ok let port = get "port" |> int
let bind_to = get "bind_to"
let master_public_key = get "master_public_key" |> ed25519
let stefan_abs = get "stefan_abs" |> amount
let stefan_log = get "stefan_log" |> amount
let stefan_lin = get_opt "stefan_lin" |> Option.map float
let stefan_abs = zero_eur let aggregator_idle_sleep_interval =
let stefan_log = zero_eur get "aggregator_idle_sleep_interval" |> duration
let stefan_lin = 0.0
let signkey_legal_duration = dummy_duration
let max_keys_caching = 9999999
let max_requests = 99999999
let terms_dir = Fpath.(v "terms")
let terms_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok
let privacy_dir = Fpath.(v "privacy")
let privacy_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok
let enable_kyc = `NO
end
let currency_eur = let closer_idle_sleep_interval = get "closer_idle_sleep_interval" |> duration
Types.Config_types.Currency.
{
enabled= `NO;
code= "EUR";
name= "euro";
fractional_input_digits= 2;
fractional_normal_digits= 2;
fractional_trailing_zero_digits= 2;
alt_unit_names= [ (0, "E"); (3, "kE") ];
}
module Secmod_rsa = struct let transfer_idle_sleep_interval =
let lookahead_sign = dummy_duration get "transfer_idle_sleep_interval" |> duration
let overlap_duration = dummy_duration
let sm_priv_key = Fpath.(v "rsa_key.priv")
let key_dir = Fpath.(v "rsa")
end
module Secmod_eddsa = struct let wirewatch_idle_sleep_interval =
let lookahead_sign = dummy_duration get "wirewatch_idle_sleep_interval" |> duration
let overlap_duration = dummy_duration
let sm_priv_key = Fpath.(v "eddsa_key.priv") let signkey_legal_duration = get "signkey_legal_duration" |> duration
let key_dir = Fpath.(v "eddsa") let max_keys_caching = get "max_keys_caching" |> duration
let enable_kyc = get "enable_kyc" |> yes_no
let terms_etag = get "terms_etag"
let privacy_etag = get "privacy_etag"
(* optional:
tiny_amount
shopping_url
open_banking_gateway_url
aml_spa_dialect
bank_compliance_language
toplevel_redirect_url *)
(* not implemented or not relevant to MTE:
let max_requests = get "max_requests" |> int
base_url
aggregator_shard_size
serve
unixpath
unixpath_mode
terms_dir
privacy_dir *)
end end
module Exchangedb = struct module Exchangedb = struct
let idle_reserve_expiration_time = dummy_duration let get field = get config_data ~section:"exchangedb" ~field
let legal_reserve_expiration_time = dummy_duration
let aggregator_shift = dummy_duration (* - *)
let default_purse_limit = 9999 let idle_reserve_expiration_time =
let max_aml_program_runtime = dummy_duration get "idle_reserve_expiration_time" |> duration
let legal_reserve_expiration_time =
get "legal_reserve_expiration_time" |> duration
let aggregator_shift = get "aggregator_shift" |> duration
let max_aml_program_runtime = get "max_aml_program_runtime" |> duration
let default_purse_limit = get "default_purse_limit" |> int
end end
module Exchangedb_postgres = struct module Exchangedb_postgres = struct
(* pgx://<user>:<password>@<host-or-directory>:<port>/<database> *)
let config = let config =
let user = "mte" in get config_data ~section:"exchangedb-postgres" ~field:"config" |> uri
let password = "hunter2" in
let host = "localhost" in
let port = 5432 in
let database = "taler-exchange" in
Uri.of_string
@@ Fmt.str "pgx://%s:%s@%s:%d/%s" user password host port database
end end
let coin_kudo_1 = module Currency = struct
Types.Config_types.Coin. type t = {
{ enabled: [ `YES | `NO ];
section_name= "kudo_1"; code: string;
value= amount "EUR:0.01"; name: string;
duration_withdraw= dummy_duration; fractional_input_digits: int;
duration_spend= dummy_duration; fractional_normal_digits: int;
duration_legal= dummy_duration; fractional_trailing_zero_digits: int;
fee_withdraw= zero_eur; alt_unit_names: (int * string) list;
fee_deposit= zero_eur;
fee_refresh= zero_eur;
fee_refund= zero_eur;
cipher= `RSA;
rsa_keysize= 2048;
age_restricted= `NO;
} }
let coin_kudo_2 = let currency_sections =
{ coin_kudo_1 with section_name= "kudo_2"; value= amount "EUR:0.02" } List.filter
(fun v -> String.starts_with ~prefix:"currency-" v.header)
config_data
let coins = [ coin_kudo_1; coin_kudo_2 ] let parse_currency section =
let get field = get config_data ~section:section.header ~field in
{
enabled= get "enabled" |> yes_no;
code= get "code";
name= get "name";
fractional_input_digits= get "fractional_input_digits" |> int;
fractional_normal_digits= get "fractional_normal_digits" |> int;
fractional_trailing_zero_digits=
get "fractional_trailing_zero_digits" |> int;
alt_unit_names= get "alt_unit_names" |> Parse_alt_unit_names.parse;
}
let all_currencies = List.map parse_currency currency_sections
(* I think the exchange only handle one currency *)
let v =
match
List.find_opt (fun v -> v.code = Exchange.currency) all_currencies
with
| None ->
fail_with
(Fmt.str
"section `[currency-%s]` not found, currency `%s` is not defined"
Exchange.currency Exchange.currency)
| Some v -> (
match v.enabled = `YES with
| false ->
fail_with (Fmt.str "currency `%s` is not enabled" Exchange.currency)
| true -> v)
end
module Coin = struct
type t = {
section_name: string;
value: Amount.t;
duration_withdraw: Ptime.Span.t;
duration_spend: Ptime.Span.t;
duration_legal: Ptime.Span.t;
fee_withdraw: Amount.t;
fee_deposit: Amount.t;
fee_refresh: Amount.t;
fee_refund: Amount.t;
cipher: [ (* `CS |*) `RSA ];
rsa_keysize: int; (* : int option (only if `RSA) *)
age_restricted: [ (*`YES|*) `NO ];
}
let coin_sections =
List.filter
(fun v ->
(* note: here its a '_' not '-' *)
String.starts_with ~prefix:"coin_" v.header)
config_data
let parse_coin section =
let get field = get config_data ~section:section.header ~field in
let section_name =
String.sub section.header 5 (String.length section.header - 5)
in
{
section_name;
value= get "value" |> amount;
duration_withdraw= get "duration_withdraw" |> duration;
duration_spend= get "duration_spend" |> duration;
duration_legal= get "duration_legal" |> duration;
fee_withdraw= get "fee_withdraw" |> amount;
fee_deposit= get "fee_deposit" |> amount;
fee_refresh= get "fee_refresh" |> amount;
fee_refund= get "fee_refund" |> amount;
cipher= (get "cipher" |> const_value "RSA" |> fun _s -> `RSA);
rsa_keysize= get "rsa_keysize" |> int;
age_restricted=
( get "age_restricted" |> yes_no |> function
| `NO -> `NO
| `YES -> fail_with "`age_restricted = YES` is not supported" );
}
let all_coins = List.map parse_coin coin_sections
let get_coin name =
match List.find_opt (fun v -> v.section_name = name) all_coins with
| None ->
fail_with
(Fmt.str "section `[coin_%s]` not found, coin `%s` is not defined"
name name)
| Some v -> v
let kudo_1 = get_coin "kudo_1"
let kudo_2 = get_coin "kudo_2"
end
module Exchange_secmod_rsa = struct
let get field =
let section = "taler-exchange-secmod-" ^ "rsa" in
get config_data ~section ~field
let lookahead_sign = get "lookahead_sign" |> duration
let overlap_duration = get "overlap_duration" |> duration
(* not relevant: sm_priv_key key_dir unixpath *)
end
module Exchange_secmod_eddsa = struct
let get field =
let section = "taler-exchange-secmod-" ^ "eddsa" in
get config_data ~section ~field
let lookahead_sign = get "lookahead_sign" |> duration
let overlap_duration = get "overlap_duration" |> duration
end

View file

@ -36,7 +36,7 @@ let make
rsa_keysize; rsa_keysize;
age_restricted= _; age_restricted= _;
} : } :
Config_types.Coin.t) = Config.Coin.t) =
assert (cipher = `RSA); assert (cipher = `RSA);
let stamp_start = Ptime_clock.now () in let stamp_start = Ptime_clock.now () in

View file

@ -29,7 +29,7 @@ module Secmod_denom = struct
let finally _key = () in let finally _key = () in
Vif.Device.v ~name:"secmod_denom" ~finally [] @@ fun (_env : env) -> Vif.Device.v ~name:"secmod_denom" ~finally [] @@ fun (_env : env) ->
let sm_key = Signkey.generate () in let sm_key = Signkey.generate () in
let keys = List.map Denomination.make Config.coins in let keys = List.map Denomination.make Config.Coin.all_coins in
{ sm_key; keys } { sm_key; keys }
end end

View file

@ -13,6 +13,7 @@
b32 b32
; ;
include include
parse_config
; ;
caqti caqti
caqti-miou caqti-miou

View file

@ -1,35 +1,3 @@
module Config_types = struct
module Currency = struct
type t = {
enabled: [ `YES | `NO ];
code: string;
name: string;
fractional_input_digits: int;
fractional_normal_digits: int;
fractional_trailing_zero_digits: int;
alt_unit_names: (int * string) list;
}
end
module Coin = struct
type t = {
(* section_name: Name in the configuration file that defines this denomination *)
section_name: string;
value: Amount.t;
duration_withdraw: Ptime.Span.t;
duration_spend: Ptime.Span.t;
duration_legal: Ptime.Span.t;
fee_withdraw: Amount.t;
fee_deposit: Amount.t;
fee_refresh: Amount.t;
fee_refund: Amount.t;
cipher: [ (* `CS |*) `RSA ];
rsa_keysize: int; (* : int option (only if `RSA) *)
age_restricted: [ (*`YES|*) `NO ];
}
end
end
module Amount = struct module Amount = struct
include Amount include Amount