From 55c384801f85e4f9b5e88f1b8d99f5dddafcb0a1 Mon Sep 17 00:00:00 2001 From: swrup Date: Mon, 23 Feb 2026 07:24:40 +0100 Subject: [PATCH] use Int64.of_string_opt --- src/api.ml | 31 +++++++++++++------------ src/http_info.ml | 29 ++++++------------------ src/http_management.ml | 51 +++++++++++++++++++++--------------------- src/parse_config.ml | 2 -- src/respond.ml | 19 ++++++++++++++-- 5 files changed, 64 insertions(+), 68 deletions(-) diff --git a/src/api.ml b/src/api.ml index 8d9b3244..ea904667 100644 --- a/src/api.ml +++ b/src/api.ml @@ -15,7 +15,6 @@ open Crypto open Signatures module DenominationHash = Hash.DenominationHash -let encode_exn jsont v = Jsont_bytesrw.encode_string jsont v |> Result.get_ok let encode jsont v = Jsont_bytesrw.encode_string jsont v let decode jsont v = Jsont_bytesrw.decode_string jsont v @@ -228,22 +227,22 @@ module ExchangeVersionResponse = struct |> finish end +let currency_specification = + let open Config.Currency in + match Parse_config.Alt_unit_names.encode v.alt_unit_names with + | Error e -> Fmt.failwith "json encoding error on alt_unit_names: %s." e + | Ok alt_unit_names -> + 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= []; + } + let config = - let currency_specification = - let open Config.Currency 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 ExchangeVersionResponse. { version= protocol_version; diff --git a/src/http_info.ml b/src/http_info.ml index 2e4287ec..f7043ff8 100644 --- a/src/http_info.ml +++ b/src/http_info.ml @@ -17,8 +17,8 @@ let seed req _server _env = let config req _server _env = Logs.info (fun m -> m "GET /config"); - let s = Api.(encode_exn ExchangeVersionResponse.jsont config) in - Respond.ok s req + let res = Api.encode Api.ExchangeVersionResponse.jsont config in + Respond.result res req (* TODO for now we only have one item in each "denom group" @@ -65,21 +65,7 @@ let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date = 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 currency_specification = Api.currency_specification in let tiny_amount = Config.tiny_amount in let stefan_abs = Config.stefan_abs in let stefan_log = Config.stefan_log in @@ -234,15 +220,14 @@ let keys req server _env = let* last_issue_date = match Vif.Queries.get req "last_issue_date" with | [] -> Ok None - | v :: _ -> ( - match int_of_string_opt v with + | s :: _ -> ( + match Int64.of_string_opt s 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)))) + | Some n -> Ok (Some (Timestamp.of_s n))) in let* v = mk_keys ~db_conn keys ~last_issue_date in - let s = Api.encode_exn jsont v in - Ok s + Api.encode jsont v in Respond.result res req diff --git a/src/http_management.ml b/src/http_management.ml index 4e7d295f..3a6e10da 100644 --- a/src/http_management.ml +++ b/src/http_management.ml @@ -10,8 +10,7 @@ module Keys_get = struct let (module Keys : Keys.S) = Vif.Server.device Devices.keys server in let res = let* v = Keys.make_future_keys_response () in - let s = Api.encode_exn jsont v in - Ok s + Api.encode jsont v in Respond.result res req end @@ -108,9 +107,9 @@ module Keys_post = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys v in let* () = do_ ~db_conn keys v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end module Denom_revoke = struct @@ -134,9 +133,9 @@ module Denom_revoke = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys h_denom_pub v in let* () = do_ keys h_denom_pub v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end module Signkey_revoke = struct @@ -160,9 +159,9 @@ module Signkey_revoke = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys exchange_pub v in let* () = do_ keys exchange_pub v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end module Auditors = struct @@ -214,9 +213,9 @@ module Auditors = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys v in let* () = do_ ~db_conn v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end module Auditors_disable = struct @@ -255,9 +254,9 @@ module Auditors_disable = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys auditor_pub v in let* () = do_ ~db_conn auditor_pub v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end module Wire_fee = struct @@ -314,9 +313,9 @@ module Wire_fee = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys v in let* () = do_ ~db_conn v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end module Global_fees = struct @@ -385,9 +384,9 @@ module Global_fees = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys v in let* () = do_ ~db_conn v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end module Wire = struct @@ -464,9 +463,9 @@ module Wire = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys v in let* () = do_ ~db_conn v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end module Wire_disable = struct @@ -499,9 +498,9 @@ module Wire_disable = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys v in let* () = do_ ~db_conn v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end module Drain = struct @@ -539,9 +538,9 @@ module Drain = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys v in let* () = do_ ~db_conn v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end module AmlOfficer = struct @@ -579,9 +578,9 @@ module AmlOfficer = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys v in let* () = do_ ~db_conn v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end module Partners = struct @@ -621,7 +620,7 @@ module Partners = struct let* v = Vif.Request.of_json req |> unwrap_err_msg in let* () = verify keys v in let* () = do_ ~db_conn v in - Ok "" + Ok () in - Respond.result res req + Respond.result_no_content res req end diff --git a/src/parse_config.ml b/src/parse_config.ml index 86254830..8e53b77c 100644 --- a/src/parse_config.ml +++ b/src/parse_config.ml @@ -227,6 +227,4 @@ module Alt_unit_names = struct let string_map = String_map.of_list l in let+ s = Jsont_bytesrw.encode_string string_map_jsont string_map in s - - let encode_exn l = encode l |> Result.get_ok end diff --git a/src/respond.ml b/src/respond.ml index ea17f7f7..17f67039 100644 --- a/src/respond.ml +++ b/src/respond.ml @@ -1,6 +1,11 @@ (* TODO response use ErrorDetail *) +let encode_error_detail err = + match Api.(encode ErrorDetail.jsont err) with + | Error e -> Fmt.failwith "json encoding error on `ErrorDetail`: %s." e + | Ok s -> s + let respond_json req content status = let open Vif.Response in let open Syntax in @@ -12,10 +17,10 @@ let mk_error_content ?hint _status = let open Api in let code = -1 in let err = ErrorDetail.make ?hint code in - encode_exn ErrorDetail.jsont err + encode_error_detail err let error ~hint req = - Logs.err (fun m -> m "internal server error: %s" hint); + Logs.err (fun m -> m "error: %s" hint); let body = mk_error_content ~hint `Internal_server_error in respond_json req body `Internal_server_error @@ -28,6 +33,13 @@ let ok content req = Logs.debug (fun m -> m "ok"); respond_json req content `OK +let no_content () = + Logs.debug (fun m -> m "no content"); + let open Vif.Response in + let open Syntax in + let* () = empty in + respond `No_content + let not_modified () = Logs.debug (fun m -> m "not modified"); let open Vif.Response in @@ -37,3 +49,6 @@ let not_modified () = let result res req = match res with Error hint -> error ~hint req | Ok content -> ok content req + +let result_no_content res req = + match res with Error hint -> error ~hint req | Ok () -> no_content ()