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,12 +227,11 @@ module ExchangeVersionResponse = struct
     |> finish
 end
 
-let config =
 let currency_specification =
   let open Config.Currency in
-    let alt_unit_names =
+  match Parse_config.Alt_unit_names.encode v.alt_unit_names with
-      Parse_config.Alt_unit_names.encode_exn v.alt_unit_names
+  | Error e -> Fmt.failwith "json encoding error on alt_unit_names: %s." e
-    in
+  | Ok alt_unit_names ->
       CurrencySpecification.
         {
           name= v.name;
@@ -243,7 +241,8 @@ let config =
           alt_unit_names;
           common_amounts= [];
         }
-  in
+
+let config =
   ExchangeVersionResponse.
     {
       version= protocol_version;

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
+  let res = Api.encode Api.ExchangeVersionResponse.jsont config in
-  Respond.ok s req
+  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 currency_specification = Api.currency_specification in
-    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
@@ -242,7 +228,6 @@ let keys req server _env =
           | 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
+    Api.encode jsont v
-    Ok s
   in
   Respond.result res req

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
+      Api.encode jsont v
-      Ok s
     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

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

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 ()