JJ: Description from the destination commit:
better parse_config JJ: Description from source commit: better config: parse file + crunch
This commit is contained in:
parent
e2d3986989
commit
db68e2f709
11 changed files with 481 additions and 234 deletions
|
|
@ -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"
|
||||
|
|
@ -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 fmt angstrom amount))
|
||||
(libraries mirage-crypto-ec ptime fmt angstrom uri amount b32))
|
||||
|
||||
; we prefer to generate taler_signatures.ml once,
|
||||
; and commit it, for versionning:
|
||||
|
|
|
|||
|
|
@ -3,64 +3,33 @@
|
|||
|
||||
do not support "$"-path expansion*)
|
||||
|
||||
(* TODO
|
||||
- integer
|
||||
- duration
|
||||
- YES|NO
|
||||
- alt_unit_names json pair
|
||||
open Angstrom
|
||||
|
||||
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 = {
|
||||
key: string;
|
||||
value: string;
|
||||
}
|
||||
|
||||
type line =
|
||||
| Blank
|
||||
| Comment of string
|
||||
| Header of string
|
||||
| Item of item
|
||||
|
||||
type section = {
|
||||
header: string;
|
||||
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_whitespace = function ' ' | '\t' -> true | _ -> false
|
||||
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 ident_char = function
|
||||
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
|
||||
|
|
@ -86,7 +55,7 @@ module Untyped = struct
|
|||
let quoted_value =
|
||||
char '"' *> take_till is_eol >>= fun s ->
|
||||
match String.ends_with ~suffix:"\"" s with
|
||||
| false -> fail "invalid quoted value"
|
||||
| false -> fail_with "invalid quoted value"
|
||||
| true ->
|
||||
let value = String.sub s 0 (String.length s - 1) in
|
||||
return value
|
||||
|
|
@ -107,7 +76,7 @@ module Untyped = struct
|
|||
match l with
|
||||
| [] ->
|
||||
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
|
||||
| Item item :: tl -> loop section_l (item :: item_l) tl
|
||||
| Header header :: tl ->
|
||||
|
|
@ -118,8 +87,9 @@ module Untyped = struct
|
|||
|
||||
let parse s =
|
||||
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
|
||||
end
|
||||
|
||||
module Pp_debug = struct
|
||||
let pp_item ppf { key; value } =
|
||||
|
|
@ -130,6 +100,7 @@ module Untyped = struct
|
|||
|
||||
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
|
||||
|
|
@ -148,13 +119,158 @@ module Untyped = struct
|
|||
let open Fmt in
|
||||
pf ppf "%a" (list ~sep:(any "\n") pp_section) l
|
||||
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
|
||||
|
||||
let () =
|
||||
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 unwrap_res = function Error e -> fail_with (Fmt.str "`%s`." e) | Ok v -> v
|
||||
|
||||
()
|
||||
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
|
||||
|
|
|
|||
|
|
@ -35,19 +35,15 @@ let make ~sign ~currency ~value ~fraction =
|
|||
in
|
||||
Ok { sign; currency; value; fraction }
|
||||
|
||||
let to_string =
|
||||
let pp =
|
||||
let open Fmt in
|
||||
let pp_sign ppf = function
|
||||
| `Plus -> char ppf '+'
|
||||
| `Minus -> char ppf '-'
|
||||
in
|
||||
let pp_sign ppf = function `Plus -> char ppf '+' | `Minus -> char ppf '-' in
|
||||
let pp_currency ppf = function `Eur -> string ppf "EUR" in
|
||||
fun ppf { sign; currency; value; fraction } ->
|
||||
pf ppf "%a%a:%Ld.%02ld" (Fmt.option pp_sign) sign pp_currency currency
|
||||
value fraction
|
||||
in
|
||||
Fmt.str "%a" pp
|
||||
pf ppf "%a%a:%Ld.%02ld" (Fmt.option pp_sign) sign pp_currency currency value
|
||||
fraction
|
||||
|
||||
let to_string = Fmt.str "%a" pp
|
||||
|
||||
let of_string =
|
||||
let open Angstrom in
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
73
src/assets/default.config
Normal file
73
src/assets/default.config
Normal 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
|
||||
268
src/config.ml
268
src/config.ml
|
|
@ -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.
|
||||
{
|
||||
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;
|
||||
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 coin_kudo_2 =
|
||||
{ coin_kudo_1 with section_name= "kudo_2"; value= amount "EUR:0.02" }
|
||||
let currency_sections =
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
1
src/dune
|
|
@ -13,6 +13,7 @@
|
|||
b32
|
||||
;
|
||||
include
|
||||
parse_config
|
||||
;
|
||||
caqti
|
||||
caqti-miou
|
||||
|
|
|
|||
32
src/types.ml
32
src/types.ml
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue