add taler_config.ml with module sig; put config in assets.ml
This commit is contained in:
parent
be2e590e93
commit
e37802e9dc
6 changed files with 245 additions and 177 deletions
|
|
@ -7,7 +7,59 @@
|
|||
(* docs: https://docs.taler.net/manpages/taler-exchange.conf.5.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 =
|
||||
| Terms
|
||||
| Privacy
|
||||
|
|
@ -88,7 +140,7 @@ let supported_lang_arr, supported_ext_arr =
|
|||
(Array.of_list lang_l, Array.of_list ext_l)
|
||||
|
||||
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_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 etag = Headers_lib.Etag.to_raw_string (etag t) in
|
||||
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)
|
||||
| Some ext -> ext
|
||||
in
|
||||
|
|
|
|||
130
src/config.ml
130
src/config.ml
|
|
@ -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
|
||||
|
|
@ -1,16 +1,22 @@
|
|||
let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item
|
||||
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
let select_mimetype headers =
|
||||
let accept = Vif.Headers.get headers "accept" in
|
||||
Cohttp.Accept.media_ranges accept
|
||||
|> 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
|
||||
|
||||
let select_language headers =
|
||||
|
|
@ -19,14 +25,14 @@ let select_language headers =
|
|||
|> Cohttp.Accept.qsort
|
||||
|> List.map (fun (_q, lang) -> lang)
|
||||
|> List.map (function
|
||||
| Cohttp.Accept.AnyLanguage -> Config.default_lang
|
||||
| Cohttp.Accept.AnyLanguage -> Assets.Config.default_lang
|
||||
| Language language_range -> (
|
||||
(* ignore language subtags (e.g. "en-US" -> "en") *)
|
||||
match language_range with
|
||||
| [] -> assert false
|
||||
| primary_tag :: _ -> primary_tag))
|
||||
|> List.find_opt Assets.is_supported_lang
|
||||
|> Option.value ~default:Config.default_lang
|
||||
|> Option.value ~default:Assets.Config.default_lang
|
||||
|
||||
let select_encoding headers =
|
||||
Vif.Headers.get headers "accept-encoding"
|
||||
|
|
@ -37,7 +43,7 @@ let select_encoding headers =
|
|||
| Cohttp.Accept.Identity -> Some `Identity
|
||||
| Deflate -> Some `DEFLATE
|
||||
| Gzip -> Some `Gzip
|
||||
| AnyEncoding -> Some Config.default_encoding
|
||||
| AnyEncoding -> Some Assets.Config.default_encoding
|
||||
| Encoding _ | Compress -> (* unsupported *) None)
|
||||
|> function
|
||||
| [] -> assert false
|
||||
|
|
|
|||
|
|
@ -83,13 +83,13 @@ module Static = struct
|
|||
in
|
||||
let* () =
|
||||
(* 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
|
||||
let* () =
|
||||
add ~field:"avail-languages" Headers.avail_languages_header_value
|
||||
in
|
||||
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
|
||||
in
|
||||
respond `OK)
|
||||
|
|
|
|||
37
src/util.ml
37
src/util.ml
|
|
@ -1,43 +1,8 @@
|
|||
(* TODO *)
|
||||
module Protocol_version = struct
|
||||
(* libtool version format *)
|
||||
(* todo *)
|
||||
let current = 0
|
||||
let revision = 0
|
||||
let age = 0
|
||||
let v = Fmt.str "%d:%d:%d"
|
||||
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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue