diff --git a/src/http_information.ml b/src/http_information.ml new file mode 100644 index 00000000..79ac240e --- /dev/null +++ b/src/http_information.ml @@ -0,0 +1,279 @@ +open Syntax +open Api +module String_map = Stdlib.Map.Make (Stdlib.String) + +(* TODO mirage-crypto + is this ok? + maybe don't use the same RNG-initialization as the one used to generate keys *) +let seed req _server _env = + Logs.info (fun m -> m "GET /seed"); + (* RNG is initialized by Vif.run *) + let s = Mirage_crypto_rng.generate 64 in + let open Vif.Response in + let open Syntax in + let* () = add ~field:"content-type" "application/octet-stream" in + let* () = with_string req s in + respond `OK + +let config req _server _env = + Logs.info (fun m -> m "GET /config"); + let s = Api.(encode_exn ExchangeVersionResponse.jsont config) in + Respond_util.respond_with_ok_json s req + +(* TODO + for now we only have one item in each "denom group" + change this once we have denom/signkey rotation *) +let denomgroup_of_denomdata + Denom_data. + { + pub; + value; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + fee_withdraw; + fee_deposit; + fee_refresh; + fee_refund; + age_mask= _; + h_pub= _; + master_sig; + revoked_sig= _; + } = + let master_sig = match master_sig with None -> assert false | Some v -> v in + let denoms = + [ + RsaDenom. + { + rsa_pub= pub; + master_sig; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + stamp_expire_legal; + lost= None; + }; + ] + in + DenomGroup.Rsa + RsaDenomGroup. + { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund } + +let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = + let version = Api.protocol_version in + let base_url = Config.base_url in + let currency = Config.currency in + let shopping_url = Config.shopping_url in + let open_banking_gateway = Config.open_banking_gateway_url in + let bank_compliance_language = Config.bank_compliance_language in + let currency_specification = + let v = Config.Currency.v in + let alt_unit_names = + Parse_config.Alt_unit_names.encode_exn v.alt_unit_names + in + CurrencySpecification. + { + name= v.name; + num_fractional_input_digits= v.fractional_input_digits; + num_fractional_normal_digits= v.fractional_normal_digits; + num_fractional_trailing_zero_digits= v.fractional_trailing_zero_digits; + alt_unit_names; + common_amounts= []; + } + in + let tiny_amount = Config.tiny_amount in + let stefan_abs = Config.stefan_abs in + let stefan_log = Config.stefan_log in + let stefan_lin = Config.stefan_lin in + (* todo asset_type + Type of the asset. "fiat", "crypto", "regional" or "stock". *) + let asset_type = "xxx" in + let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in + let* wire_fees = + (* todo + where does wire_methods comes from? *) + let wire_method = "xxx" in + let+ wire_fees = + Pg.get_wire_fees db_conn ~wire_method |> unwrap_err_caqti + in + String_map.singleton wire_method wire_fees + in + let wads = + (* TODO wads *) + [] + in + let rewards_allowed = false in + let kyc_enabled = false in + let disable_direct_deposit = (* todo *) false in + let master_public_key = Config.master_public_key in + let reserve_closing_delay = Config.Exchangedb.idle_reserve_expiration_time in + (* todo *) + let wallet_balance_limit_without_kyc = None in + let hard_limits = [] in + let zero_limits = [] in + let denom_data_l = + (* TODO sm-db *) + (*Pg.get_denominations db_conn |> unwrap_err_caqti *) + Sm.get_denoms_data () + in + let denom_data_l = + (* reverse chronological order *) + List.sort + (fun a b -> Stdlib.compare b.Denom_data.stamp_start a.stamp_start) + denom_data_l + in + let list_issue_date = + match denom_data_l with + | [] -> Time.Timestamp.never + | v :: _ -> v.Denom_data.stamp_start + in + let denominations = + let open Denom_data in + (* if `?last_issue_date` query param does not exactly match the `stamp_start` + of one of the denomination keys, all keys are returned *) + let l = + match last_issue_date with + | None -> denom_data_l + | Some last_issue_date -> ( + match + List.find_opt + (fun v -> + Time.Timestamp.compare v.stamp_start last_issue_date = 0) + denom_data_l + with + | None -> denom_data_l + | Some _ -> + List.filter + (fun v -> + Time.Timestamp.compare v.stamp_start last_issue_date >= 0) + denom_data_l) + in + List.map denomgroup_of_denomdata l + in + + let signkeys = + (* TODO sm-db + use database signkey data / verify secmod and database are in sync *) + (* + let now = Ptime_clock.now () |> Option.some in + let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*) + let signkey_data_l = Sm.get_signkeys_data () in + let signkey_data_l = + List.sort + (fun a b -> + let open Signkey_data in + Stdlib.compare b.stamp_start a.stamp_start) + signkey_data_l + in + List.filter_map + (fun Signkey_data. + { + pub; + stamp_start; + stamp_expire; + stamp_end; + master_sig; + revoked_sig= _; + } -> + match master_sig with + | None -> None + | Some master_sig -> + Some + SignKey. + { key= pub; stamp_start; stamp_expire; stamp_end; master_sig }) + signkey_data_l + in + + let exchange_pub = + (* the eddsa pub key used to sign exchange_sig *) + match signkeys with + | [] -> Fmt.failwith "exchange has no active signkey" + | v :: _ -> v.SignKey.key + in + let exchange_sig = + (* Compact EdDSA signature (binary-only) over the + contatentation of all of the master_sigs (in reverse + chronological order by group) in the arrays under "denominations". *) + let hc = + denom_data_l + |> List.filter_map (fun v -> v.Denom_data.master_sig) + |> List.map Signatures.DenominationKeyValidity.to_octets + |> String.concat "" + |> Hash.H64.hash + in + let open Signatures.ExchangeKeySet in + sign_f ~f:(Sm.sign_with_signkey ~pub:exchange_pub) R.{ list_issue_date; hc } + in + + let recoup = (* TODO /recoup *) [] in + let* global_fees = + Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti + in + let* auditors = + (* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *) + (* does not contains auditor_keys with empty denomination_keys *) + Pg.get_auditor_keys db_conn + in + let extensions = None in + let extensions_sig = None in + Ok + ExchangeKeysResponse. + { + version; + base_url; + currency; + shopping_url; + open_banking_gateway; + bank_compliance_language; + currency_specification; + tiny_amount; + stefan_abs; + stefan_log; + stefan_lin; + asset_type; + accounts; + wire_fees; + wads; + rewards_allowed; + kyc_enabled; + disable_direct_deposit; + master_public_key; + reserve_closing_delay; + wallet_balance_limit_without_kyc; + hard_limits; + zero_limits; + denominations; + exchange_sig; + exchange_pub; + recoup; + global_fees; + list_issue_date; + auditors; + signkeys; + extensions; + extensions_sig; + } + +let jsont = ExchangeKeysResponse.jsont + +let keys req server _env = + Logs.info (fun m -> m "GET /keys"); + let db_conn = Vif.Server.device Devices.db_connection server in + let sm = Vif.Server.device Devices.secmod server in + let res = + let* last_issue_date = + match Vif.Queries.get req "last_issue_date" with + | [] -> Ok None + | v :: _ -> ( + match int_of_string_opt v with + | None -> + Error + "invalid `?last_issue_date` query param, int_of_string failure" + | Some n -> Ok (Some (Time.Timestamp.of_s (Int64.of_int n)))) + in + let* v = mk_keys ~db_conn sm ~last_issue_date in + let s = Api.encode_exn jsont v in + Ok s + in + Respond_util.respond_with_res res req diff --git a/src/http_keys.ml b/src/http_keys.ml index 760e6cbe..e69de29b 100644 --- a/src/http_keys.ml +++ b/src/http_keys.ml @@ -1,261 +0,0 @@ -open Syntax -open Api -module String_map = Stdlib.Map.Make (Stdlib.String) - -(* TODO - for now we only have one item in each "denom group" - change this once we have denom/signkey rotation *) -let denomgroup_of_denomdata - Denom_data. - { - pub; - value; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - fee_withdraw; - fee_deposit; - fee_refresh; - fee_refund; - age_mask= _; - h_pub= _; - master_sig; - revoked_sig= _; - } = - let master_sig = match master_sig with None -> assert false | Some v -> v in - let denoms = - [ - RsaDenom. - { - rsa_pub= pub; - master_sig; - stamp_start; - stamp_expire_withdraw; - stamp_expire_deposit; - stamp_expire_legal; - lost= None; - }; - ] - in - DenomGroup.Rsa - RsaDenomGroup. - { denoms; value; fee_withdraw; fee_deposit; fee_refresh; fee_refund } - -let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = - let version = Api.protocol_version in - let base_url = Config.base_url in - let currency = Config.currency in - let shopping_url = Config.shopping_url in - let open_banking_gateway = Config.open_banking_gateway_url in - let bank_compliance_language = Config.bank_compliance_language in - let currency_specification = - let v = Config.Currency.v in - let alt_unit_names = - Parse_config.Alt_unit_names.encode_exn v.alt_unit_names - in - CurrencySpecification. - { - name= v.name; - num_fractional_input_digits= v.fractional_input_digits; - num_fractional_normal_digits= v.fractional_normal_digits; - num_fractional_trailing_zero_digits= v.fractional_trailing_zero_digits; - alt_unit_names; - common_amounts= []; - } - in - let tiny_amount = Config.tiny_amount in - let stefan_abs = Config.stefan_abs in - let stefan_log = Config.stefan_log in - let stefan_lin = Config.stefan_lin in - (* todo asset_type - Type of the asset. "fiat", "crypto", "regional" or "stock". *) - let asset_type = "xxx" in - let* accounts = Pg.get_wire_accounts db_conn |> unwrap_err_caqti in - let* wire_fees = - (* todo - where does wire_methods comes from? *) - let wire_method = "xxx" in - let+ wire_fees = - Pg.get_wire_fees db_conn ~wire_method |> unwrap_err_caqti - in - String_map.singleton wire_method wire_fees - in - let wads = - (* TODO wads *) - [] - in - let rewards_allowed = false in - let kyc_enabled = false in - let disable_direct_deposit = (* todo *) false in - let master_public_key = Config.master_public_key in - let reserve_closing_delay = Config.Exchangedb.idle_reserve_expiration_time in - (* todo *) - let wallet_balance_limit_without_kyc = None in - let hard_limits = [] in - let zero_limits = [] in - let denom_data_l = - (* TODO sm-db *) - (*Pg.get_denominations db_conn |> unwrap_err_caqti *) - Sm.get_denoms_data () - in - let denom_data_l = - (* reverse chronological order *) - List.sort - (fun a b -> Stdlib.compare b.Denom_data.stamp_start a.stamp_start) - denom_data_l - in - let list_issue_date = - match denom_data_l with - | [] -> Time.Timestamp.never - | v :: _ -> v.Denom_data.stamp_start - in - let denominations = - let open Denom_data in - (* if `?last_issue_date` query param does not exactly match the `stamp_start` - of one of the denomination keys, all keys are returned *) - let l = - match last_issue_date with - | None -> denom_data_l - | Some last_issue_date -> ( - match - List.find_opt - (fun v -> - Time.Timestamp.compare v.stamp_start last_issue_date = 0) - denom_data_l - with - | None -> denom_data_l - | Some _ -> - List.filter - (fun v -> - Time.Timestamp.compare v.stamp_start last_issue_date >= 0) - denom_data_l) - in - List.map denomgroup_of_denomdata l - in - - let signkeys = - (* TODO sm-db - use database signkey data / verify secmod and database are in sync *) - (* - let now = Ptime_clock.now () |> Option.some in - let+ signkey_data_l = Pg.get_active_signkeys db_conn ~now |> unwrap_err_caqti in*) - let signkey_data_l = Sm.get_signkeys_data () in - let signkey_data_l = - List.sort - (fun a b -> - let open Signkey_data in - Stdlib.compare b.stamp_start a.stamp_start) - signkey_data_l - in - List.filter_map - (fun Signkey_data. - { - pub; - stamp_start; - stamp_expire; - stamp_end; - master_sig; - revoked_sig= _; - } -> - match master_sig with - | None -> None - | Some master_sig -> - Some - SignKey. - { key= pub; stamp_start; stamp_expire; stamp_end; master_sig }) - signkey_data_l - in - - let exchange_pub = - (* the eddsa pub key used to sign exchange_sig *) - match signkeys with - | [] -> Fmt.failwith "exchange has no active signkey" - | v :: _ -> v.SignKey.key - in - let exchange_sig = - (* Compact EdDSA signature (binary-only) over the - contatentation of all of the master_sigs (in reverse - chronological order by group) in the arrays under "denominations". *) - let hc = - denom_data_l - |> List.filter_map (fun v -> v.Denom_data.master_sig) - |> List.map Signatures.DenominationKeyValidity.to_octets - |> String.concat "" - |> Hash.H64.hash - in - let open Signatures.ExchangeKeySet in - sign_f ~f:(Sm.sign_with_signkey ~pub:exchange_pub) R.{ list_issue_date; hc } - in - - let recoup = (* TODO /recoup *) [] in - let* global_fees = - Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti - in - let* auditors = - (* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *) - (* does not contains auditor_keys with empty denomination_keys *) - Pg.get_auditor_keys db_conn - in - let extensions = None in - let extensions_sig = None in - Ok - ExchangeKeysResponse. - { - version; - base_url; - currency; - shopping_url; - open_banking_gateway; - bank_compliance_language; - currency_specification; - tiny_amount; - stefan_abs; - stefan_log; - stefan_lin; - asset_type; - accounts; - wire_fees; - wads; - rewards_allowed; - kyc_enabled; - disable_direct_deposit; - master_public_key; - reserve_closing_delay; - wallet_balance_limit_without_kyc; - hard_limits; - zero_limits; - denominations; - exchange_sig; - exchange_pub; - recoup; - global_fees; - list_issue_date; - auditors; - signkeys; - extensions; - extensions_sig; - } - -let jsont = ExchangeKeysResponse.jsont - -let f req server _env = - Logs.info (fun m -> m "GET /keys"); - let db_conn = Vif.Server.device Devices.db_connection server in - let sm = Vif.Server.device Devices.secmod server in - let res = - let* last_issue_date = - match Vif.Queries.get req "last_issue_date" with - | [] -> Ok None - | v :: _ -> ( - match int_of_string_opt v with - | None -> - Error - "invalid `?last_issue_date` query param, int_of_string failure" - | Some n -> Ok (Some (Time.Timestamp.of_s (Int64.of_int n)))) - in - let* v = mk_keys ~db_conn sm ~last_issue_date in - let s = Api.encode_exn jsont v in - Ok s - in - Respond_util.respond_with_res res req diff --git a/src/mte.ml b/src/mte.ml index 159f688b..abfc68a8 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -13,24 +13,6 @@ You should have received a copy of the GNU Affero General Public License along with this program. If not, see . *) -(* TODO mirage-crypto - is this ok? - maybe don't use the same RNG-initialization as the one used to generate keys *) -let seed req _server _env = - Logs.info (fun m -> m "GET /seed"); - (* RNG is initialized by Vif.run *) - let s = Mirage_crypto_rng.generate 64 in - let open Vif.Response in - let open Syntax in - let* () = add ~field:"content-type" "application/octet-stream" in - let* () = with_string req s in - respond `OK - -let config req _server _env = - Logs.info (fun m -> m "GET /config"); - let s = Api.(encode_exn ExchangeVersionResponse.jsont config) in - Respond_util.respond_with_ok_json s req - let hello req _server _env = let open Vif.Response in let open Syntax in @@ -53,9 +35,9 @@ let routes = in let status_info = [ - get_ (rel / "seed") --> seed; - get_ (rel / "config") --> config; - get_ (rel / "keys") --> Http_keys.f; + get_ (rel / "seed") --> Http_information.seed; + get_ (rel / "config") --> Http_information.config; + get_ (rel / "keys") --> Http_information.keys; ] in let management =