swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

JJ: Description from the destination commit:

Browse source 
+ exchangedb-postgres

JJ: Description from source commit:
better config: parse file + crunch
This commit is contained in:
swrup 2025-11-20 20:30:41 +01:00
parent 51007ff612
commit 4e860da2f7
9 changed files with 218 additions and 337 deletions
Download patch file Download diff file Expand all files Collapse all files

4
include/dune
View file

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

203
include/parse_config.ml
View file

@ -3,11 +3,6 @@
do not support "$"-path expansion*)
(* TODO
- do all config section
- parse alt_unit_names json pair
*)
open Angstrom
type item = {
@ -21,14 +16,14 @@ type section = {
}
let fail_with msg =
Fmt.epr "Failed to parse configuration: %s.@." msg;
Fmt.epr "Configuration failure: %s.@." msg;
exit 1
let is_eol = function '\n' | '\r' -> true | _ -> false
let is_whitespace = function ' ' | '\t' -> true | _ -> false
let whitespace = skip_while is_whitespace
module Parse_file = struct
module Parse_data = struct
type line =
| Blank
| Comment of string
@ -90,7 +85,7 @@ module Parse_file = struct
in
loop [] [] (List.rev l)
let parse_content s =
let parse s =
match parse_string ~consume:All config s with
| Error msg -> fail_with (Fmt.str "parse error `%s`" msg)
| Ok v -> fold_sections v
@ -105,7 +100,7 @@ module Pp_debug = struct
let pp_line ppf line =
let open Fmt in
let open Parse_file in
let open Parse_data in
match line with
| Blank -> Fmt.nop ppf ()
| Comment s -> pf ppf "#%s" s
@ -225,6 +220,7 @@ let yes_no = function
| "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)
@ -278,192 +274,3 @@ module Parse_alt_unit_names = struct
in
(k, v))
end
module Config = struct
[@@@ocaml.warning "-32-69"]
let config =
let read_file file = In_channel.with_open_bin file In_channel.input_all in
let content = read_file "default.config" in
let v = Parse_file.parse_content content in
(*Fmt.pr "config file:@\n%a@." Pp_debug.pp_config v;*)
v
module Exchange = struct
let get_opt field = get_opt config ~section:"exchange" ~field
let get field = get config ~section:"exchange" ~field
(* - *)
let currency = (* todo: constraint on currency string *) get "currency"
let currency_round_unit = get "currency_round_unit" |> amount
let db = get "db" |> const_value "postgres"
let attribute_encryption_key = get "attribute_encryption_key"
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 aggregator_idle_sleep_interval =
get "aggregator_idle_sleep_interval" |> duration
let closer_idle_sleep_interval =
get "closer_idle_sleep_interval" |> duration
let transfer_idle_sleep_interval =
get "transfer_idle_sleep_interval" |> duration
let wirewatch_idle_sleep_interval =
get "wirewatch_idle_sleep_interval" |> duration
let signkey_legal_duration = get "signkey_legal_duration" |> duration
let max_keys_caching = get "max_keys_caching" |> duration
let enable_kyc = get "enable_kyc" |> yes_no
(* 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
terms_etag
privacy_dir
privacy_etag *)
end
module Exchangedb = struct
let get field = get config ~section:"exchangedb" ~field
(* - *)
let idle_reserve_expiration_time =
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
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;
}
let currency_sections =
List.filter
(fun v -> String.starts_with ~prefix:"currency-" v.header)
config
let parse_currency section =
let get field = get config ~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 -> v
(*
let () =
let pp_pair ppf (k, v) = Fmt.pf ppf "k: %d - v: %s" k v in
Fmt.epr "alt unit names:@\n%a@." (Fmt.list pp_pair) v.alt_unit_names;
()
*)
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
let parse_coin section =
let get field = get config ~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
end

12
src/assets.ml
View file

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

33
default.config → src/assets/default.config
View file

@ -1,23 +1,5 @@
# 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"
[currency-EUR]
enabled= NO
enabled= YES
code= EUR
name= euro
fractional_input_digits= 2
@ -43,6 +25,8 @@ 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"
@ -51,6 +35,17 @@ 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"

266
src/config.ml
View file

@ -1,100 +1,208 @@
(* hardcoded config for now *)
open Parse_config
let amount s = Amount.of_string s |> Result.get_ok
let zero_eur = amount "EUR:0.00"
let dummy_duration = Ptime.Span.of_int_s 99999999
let config_data =
let path = Fpath.to_string (Fpath.v "default.config") in
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
let currency = "EUR"
let currency_round_unit = amount "EUR:0.01"
let db = `Pgx (* plugin to use for the database *)
let attribute_encryption_key = "uhuhg" (* high-entropy nonce. *)
let port = 3434
let get_opt field = get_opt config_data ~section:"exchange" ~field
let get field = get config_data ~section:"exchange" ~field
let master_public_key =
"8MQF2XPWCKCW4199JFPE08X7Y9XAX21SF2HD8NZKXM3PY3CMCJ90===="
|> B32.decode
|> Result.get_ok
|> Mirage_crypto_ec.Ed25519.pub_of_octets
|> Result.get_ok
(* - *)
let currency = (* todo: constraint on currency string *) get "currency"
let currency_round_unit = get "currency_round_unit" |> amount
let db = get "db" |> const_value "postgres"
let attribute_encryption_key = get "attribute_encryption_key"
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 stefan_log = zero_eur
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 aggregator_idle_sleep_interval =
get "aggregator_idle_sleep_interval" |> duration
let currency_eur =
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") ];
}
let closer_idle_sleep_interval = get "closer_idle_sleep_interval" |> duration
module Secmod_rsa = struct
let lookahead_sign = dummy_duration
let overlap_duration = dummy_duration
let sm_priv_key = Fpath.(v "rsa_key.priv")
let key_dir = Fpath.(v "rsa")
end
let transfer_idle_sleep_interval =
get "transfer_idle_sleep_interval" |> duration
module Secmod_eddsa = struct
let lookahead_sign = dummy_duration
let overlap_duration = dummy_duration
let sm_priv_key = Fpath.(v "eddsa_key.priv")
let key_dir = Fpath.(v "eddsa")
let wirewatch_idle_sleep_interval =
get "wirewatch_idle_sleep_interval" |> duration
let signkey_legal_duration = get "signkey_legal_duration" |> duration
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
module Exchangedb = struct
let idle_reserve_expiration_time = dummy_duration
let legal_reserve_expiration_time = dummy_duration
let aggregator_shift = dummy_duration
let default_purse_limit = 9999
let max_aml_program_runtime = dummy_duration
let get field = get config_data ~section:"exchangedb" ~field
(* - *)
let idle_reserve_expiration_time =
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
module Exchangedb_postgres = struct
(* pgx://<user>:<password>@<host-or-directory>:<port>/<database> *)
let config =
let user = "mte" in
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
get config_data ~section:"exchangedb-postgres" ~field:"config" |> uri
end
let coin_kudo_1 =
Types.Config_types.Coin.
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;
}
let currency_sections =
List.filter
(fun v -> String.starts_with ~prefix:"currency-" v.header)
config_data
let parse_currency section =
let get field = get config_data ~section:section.header ~field in
{
section_name= "kudo_1";
value= amount "EUR:0.01";
duration_withdraw= dummy_duration;
duration_spend= dummy_duration;
duration_legal= dummy_duration;
fee_withdraw= zero_eur;
fee_deposit= zero_eur;
fee_refresh= zero_eur;
fee_refund= zero_eur;
cipher= `RSA;
rsa_keysize= 2048;
age_restricted= `NO;
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 coin_kudo_2 =
{ coin_kudo_1 with section_name= "kudo_2"; value= amount "EUR:0.02" }
let all_currencies = List.map parse_currency currency_sections
let coins = [ coin_kudo_1; coin_kudo_2 ]
(* 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

2
src/denomination.ml
View file

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

2
src/devices.ml
View file

@ -29,7 +29,7 @@ module Secmod_denom = struct
let finally _key = () in
Vif.Device.v ~name:"secmod_denom" ~finally [] @@ fun (_env : env) ->
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 }
end

1
src/dune
View file

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

32
src/types.ml
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
include Amount