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

JJ: Description from the destination commit:

Browse source 
wip: better config

JJ: Description from source commit:
~ config
This commit is contained in:
swrup 2025-10-13 00:29:33 +02:00
parent be2e590e93
commit 0b5a1eaabc
6 changed files with 245 additions and 177 deletions
Download patch file Download diff file Expand all files Collapse all files

58
src/assets.ml
View file

@ -7,7 +7,59 @@
(* docs: https://docs.taler.net/manpages/taler-exchange.conf.5.html (* docs: https://docs.taler.net/manpages/taler-exchange.conf.5.html
https://docs.taler.net/design-documents/003-tos-rendering.html *) https://docs.taler.net/design-documents/003-tos-rendering.html *)
(* todo: maybe move this type to config.ml *) (* hardcoded config just for static assets *)
module Config = struct
let default_lang = "en"
let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
(* TODO Taler documentation markdown mimetype should be the prefered one, and be
supported, according to DD we take text/plain as default instead for now *)
let default_mimetype = ("text", "plain")
let default_extension = ".txt"
let terms_dir = Fpath.(v "terms")
let privacy_dir = Fpath.(v "privacy")
(* ETAG is used as base filename it should be encoded in Crockford base-32 we do
not generate it and we do not verify it *)
let terms_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok
let privacy_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok
let terms_legal_version = "1"
let privacy_legal_version = "1"
end
module Mimetype = struct
let mimetype_extension_assoc =
[
(("text", "plain"), ".txt"); (("text", "markdown"), ".md");
(("text", "html"), ".html"); (("text", "html"), ".htm");
(("application", "pdf"), ".pdf"); (("image", "jpeg"), ".jpg");
(("image", "jpeg"), ".jpeg"); (("image", "png"), ".png");
(("image", "gif"), ".gif");
]
let mimetype_l, _ = List.split mimetype_extension_assoc
let of_cohttp_media = function
| Cohttp.Accept.MediaType (m, m_sub) ->
List.find_opt (( = ) (m, m_sub)) mimetype_l
| AnyMediaSubtype m ->
List.find_opt (fun (m', _) -> String.equal m m') mimetype_l
| AnyMedia -> Some Config.default_mimetype
let to_extension (m, m_sub) =
assert (m <> "*");
assert (m_sub <> "*");
List.assoc_opt (m, m_sub) mimetype_extension_assoc
let of_extension ext =
List.find_map
(fun (mime, ext') ->
match String.equal ext ext' with false -> None | true -> Some mime)
mimetype_extension_assoc
let pp_mime fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
end
type t = type t =
| Terms | Terms
| Privacy | Privacy
@ -88,7 +140,7 @@ let supported_lang_arr, supported_ext_arr =
(Array.of_list lang_l, Array.of_list ext_l) (Array.of_list lang_l, Array.of_list ext_l)
let supported_mimetype_arr = let supported_mimetype_arr =
Array.map Util.Mimetype.of_extension supported_ext_arr |> Array.map Option.get Array.map Mimetype.of_extension supported_ext_arr |> Array.map Option.get
let is_supported_lang lang = Array.mem lang supported_lang_arr let is_supported_lang lang = Array.mem lang supported_lang_arr
let is_supported_ext ext = Array.mem ext supported_ext_arr let is_supported_ext ext = Array.mem ext supported_ext_arr
@ -101,7 +153,7 @@ let is_supported_mimetype mime = Array.mem mime supported_mimetype_arr
let get_content ~lang ~mime t = let get_content ~lang ~mime t =
let etag = Headers_lib.Etag.to_raw_string (etag t) in let etag = Headers_lib.Etag.to_raw_string (etag t) in
let ext = let ext =
match Util.Mimetype.to_extension mime with match Mimetype.to_extension mime with
| None -> Fmt.failwith "mimetype `%s/%s` unknown" (fst mime) (snd mime) | None -> Fmt.failwith "mimetype `%s/%s` unknown" (fst mime) (snd mime)
| Some ext -> ext | Some ext -> ext
in in

130
src/config.ml
View file

@ -1,130 +0,0 @@
(* https://docs.taler.net/manpages/taler-exchange.conf.5.html#exchange-options *)
(* TODO
- generate `config.ml` from config file (virtual module)?
- no relative path *)
let default_lang = "en"
let default_encoding : [< `Identity | `DEFLATE | `Gzip ] = `Identity
(* TODO Taler documentation markdown mimetype should be the prefered one, and be
supported, according to DD we take text/plain as default instead for now *)
let default_mimetype = ("text", "plain")
let default_extension = ".txt"
let terms_dir = Fpath.(v "terms")
let privacy_dir = Fpath.(v "privacy")
(* ETAG is used as base filename it should be encoded in Crockford base-32 we do
not generate it and we do not verify it *)
let terms_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok
let privacy_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok
let terms_legal_version = "1"
let privacy_legal_version = "1"
(* ---- *)
let currency = `Eur
let currency_to_string = function `Eur -> "EUR"
(* Values that represent an amount are in the usual amount syntax: CURRENCY:VALUE.FRACTION,
e.g. EUR:1.50. The FRACTION portion may extend up to 8 places. *)
type value = {
currency: [ `Eur ];
value: int;
fraction: int;
}
let currency_round_unit = { currency= `Eur; value= 0; fraction= 1 }
let value_to_string v =
Fmt.str "%s:%d.%d" (currency_to_string v.currency) v.value v.fraction
(* todo: use relevant duration, all set to 1 year for now *)
module Coin = struct
(* How much is the coin worth, the format is CURRENCY:VALUE.FRACTION. For
example, a 10 cent piece is “EUR:0.10”. *)
let value = { currency= `Eur; value= 0; fraction= 1 }
(*How long can a coin of this type be withdrawn? This limits the losses
incurred by the exchange when a denomination key is compromised.*)
let duration_withdraw = Duration.of_year 1
(*How long is a coin of the given type valid? Smaller values result in lower
storage costs for the exchange.*)
let duration_spend = Duration.of_year 1
(*How long is the coin of the given type legal?*)
let duration_legal = Duration.of_year 1
(*What does it cost to withdraw this coin? Specified using the same format as
value.*)
let fee_withdraw = { currency= `Eur; value= 0; fraction= 0 }
(*What does it cost to deposit this coin? Specified using the same format as
value.*)
let fee_deposit = { currency= `Eur; value= 0; fraction= 0 }
(*What does it cost to refresh this coin? Specified using the same format as
value.*)
let fee_refresh = { currency= `Eur; value= 0; fraction= 0 }
(*What does it cost to refund this coin? Specified using the same format as
value.*)
let fee_refund = { currency= `Eur; value= 0; fraction= 0 }
(*Which cipher to use for this coin? Must be either RSA or CS.*)
let cipher : [ `RSA | `CS ] = `RSA
(*How many bits should the RSA modulus (product of the two primes) have for
this type of coin.*)
let rsa_keysize = -1
(*Set to YES to make this a denomination with support*)
let age_restricted : [ `YES | `NO ] = `NO
end
(* Crockford Base32-encoded master public key, public version of the exchange’s long-time offline signing key. *)
let master_public_key = "uhuh"
(* module type for CS/EDDSA/RSA config *)
module Secmod = struct
(* Note that the taler-exchange-secmod-rsa also evaluates the [coin_*] configuration sections described below. *)
(*How long do we generate denomination and signing keys ahead of time?*)
let lookahead_sign = Duration.of_year 1
(*How much should validity periods for coins overlap? Should be long enough to avoid problems with wallets picking one key and then due to network latency another key being valid. The DURATION_WITHDRAW period must be longer than this value.*)
let overlap_duration = Duration.of_year 1
(*
Where should the security module store its long-term private key?
SM_PRIV_KEY
Where should the security module store the private keys it manages?
KEY_DIR
On which path should the security module listen for signing requests?
UNIXPATH
*)
end
module Database = struct
(*After which time period should reserves be closed if they are idle?*)
let idle_reserve_expiration_time = -1
(*After what time do we forget about (drained) reserves during garbage collection?*)
let legal_reserve_expiration_time = -1
(*Delay between a deposit being eligible for aggregation and the aggregator actually triggering.*)
let aggregator_shift = -1
(*Number of concurrent purses that a reserve may have active if it is paid to be opened for a year.*)
let default_purse_limit = -1
(*Maximum time an AML program is allowed to run. (Optional for taler-auditor.)*)
let max_aml_program_runtime = -1
module Postgres = struct
(*How to access the database, e.g. “postgres:///taler-exchange” to use the “taler-exchange” database. Testcases use “talercheck”.*)
let config = "uhuh"
end
end

18
src/headers.ml
View file

@ -1,16 +1,22 @@
let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item
let accept_header_value = let accept_header_value =
let s = Fmt.str "%a" Util.(pp_array pp_mime) Assets.supported_mimetype_arr in let s =
Fmt.str "%a"
(pp_array Assets.Mimetype.pp_mime)
Assets.supported_mimetype_arr
in
s s
let avail_languages_header_value = let avail_languages_header_value =
let s = Fmt.str "%a" (Util.pp_array Fmt.string) Assets.supported_lang_arr in let s = Fmt.str "%a" (pp_array Fmt.string) Assets.supported_lang_arr in
s s
let select_mimetype headers = let select_mimetype headers =
let accept = Vif.Headers.get headers "accept" in let accept = Vif.Headers.get headers "accept" in
Cohttp.Accept.media_ranges accept Cohttp.Accept.media_ranges accept
|> Cohttp.Accept.qsort |> Cohttp.Accept.qsort
|> List.filter_map (fun (_q, (m, _p)) -> Util.Mimetype.of_cohttp_media m) |> List.filter_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp_media m)
|> List.find_opt Assets.is_supported_mimetype |> List.find_opt Assets.is_supported_mimetype
let select_language headers = let select_language headers =
@ -19,14 +25,14 @@ let select_language headers =
|> Cohttp.Accept.qsort |> Cohttp.Accept.qsort
|> List.map (fun (_q, lang) -> lang) |> List.map (fun (_q, lang) -> lang)
|> List.map (function |> List.map (function
| Cohttp.Accept.AnyLanguage -> Config.default_lang | Cohttp.Accept.AnyLanguage -> Assets.Config.default_lang
| Language language_range -> ( | Language language_range -> (
(* ignore language subtags (e.g. "en-US" -> "en") *) (* ignore language subtags (e.g. "en-US" -> "en") *)
match language_range with match language_range with
| [] -> assert false | [] -> assert false
| primary_tag :: _ -> primary_tag)) | primary_tag :: _ -> primary_tag))
|> List.find_opt Assets.is_supported_lang |> List.find_opt Assets.is_supported_lang
|> Option.value ~default:Config.default_lang |> Option.value ~default:Assets.Config.default_lang
let select_encoding headers = let select_encoding headers =
Vif.Headers.get headers "accept-encoding" Vif.Headers.get headers "accept-encoding"
@ -37,7 +43,7 @@ let select_encoding headers =
| Cohttp.Accept.Identity -> Some `Identity | Cohttp.Accept.Identity -> Some `Identity
| Deflate -> Some `DEFLATE | Deflate -> Some `DEFLATE
| Gzip -> Some `Gzip | Gzip -> Some `Gzip
| AnyEncoding -> Some Config.default_encoding | AnyEncoding -> Some Assets.Config.default_encoding
| Encoding _ | Compress -> (* unsupported *) None) | Encoding _ | Compress -> (* unsupported *) None)
|> function |> function
| [] -> assert false | [] -> assert false

4
src/mte.ml
View file

@ -83,13 +83,13 @@ module Static = struct
in in
let* () = let* () =
(* todo: is it "taler-privacy-version" for /policy ? *) (* todo: is it "taler-privacy-version" for /policy ? *)
add ~field:"taler-terms-version" Config.terms_legal_version add ~field:"taler-terms-version" Assets.Config.terms_legal_version
in in
let* () = let* () =
add ~field:"avail-languages" Headers.avail_languages_header_value add ~field:"avail-languages" Headers.avail_languages_header_value
in in
let* () = let* () =
let content_type = Fmt.str "%a" Util.pp_mime mime in let content_type = Fmt.str "%a" Assets.Mimetype.pp_mime mime in
add ~field:"content-type" content_type add ~field:"content-type" content_type
in in
respond `OK) respond `OK)

175
src/taler_config.ml Normal file
View file

@ -0,0 +1,175 @@
(* 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

37
src/util.ml
View file

@ -1,43 +1,8 @@
(* TODO *)
module Protocol_version = struct module Protocol_version = struct
(* libtool version format *) (* libtool version format *)
(* todo *)
let current = 0 let current = 0
let revision = 0 let revision = 0
let age = 0 let age = 0
let v = Fmt.str "%d:%d:%d" let v = Fmt.str "%d:%d:%d"
end end
module Mimetype = struct
let mimetype_extension_assoc =
[
(("text", "plain"), ".txt"); (("text", "markdown"), ".md");
(("text", "html"), ".html"); (("text", "html"), ".htm");
(("application", "pdf"), ".pdf"); (("image", "jpeg"), ".jpg");
(("image", "jpeg"), ".jpeg"); (("image", "png"), ".png");
(("image", "gif"), ".gif");
]
let mimetype_l, _ = List.split mimetype_extension_assoc
let of_cohttp_media = function
| Cohttp.Accept.MediaType (m, m_sub) ->
List.find_opt (( = ) (m, m_sub)) mimetype_l
| AnyMediaSubtype m ->
List.find_opt (fun (m', _) -> String.equal m m') mimetype_l
| AnyMedia -> Some Config.default_mimetype
let to_extension (m, m_sub) =
assert (m <> "*");
assert (m_sub <> "*");
List.assoc_opt (m, m_sub) mimetype_extension_assoc
let of_extension ext =
List.find_map
(fun (mime, ext') ->
match String.equal ext ext' with false -> None | true -> Some mime)
mimetype_extension_assoc
end
(* -- pretty printers -- *)
let pp_mime fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)
let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item