~

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 currency_specification =
   let open Config.Currency in
-    let alt_unit_names =
-      Parse_config.Alt_unit_names.encode_exn v.alt_unit_names
-    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;
@@ -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
-  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

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

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/pg.ml

@@ -37,7 +37,7 @@ let preflight =
 
 let find_signkey =
   let req =
-    Caqti_type.(eddsa_pub ->? signkey_data)
+    Caqti_type.(eddsa_pub ->? signkey)
       "SELECT exchange_pub, valid_from, expire_sign, expire_legal, master_sig \
        FROM exchange_sign_keys WHERE exchange_pub=$1"
   in
@@ -46,7 +46,7 @@ let find_signkey =
 
 let get_active_signkeys =
   let req =
-    Caqti_type.(time ->* signkey_data)
+    Caqti_type.(time ->* signkey)
       "SELECT esk.exchange_pub, esk.valid_from, esk.expire_sign, \
        esk.expire_legal, esk.master_sig FROM exchange_sign_keys esk WHERE \
        expire_sign > $1 AND NOT EXISTS (SELECT esk_serial FROM \
@@ -56,7 +56,7 @@ let get_active_signkeys =
 
 let insert_signkey =
   let req =
-    Caqti_type.(signkey_data ->. unit)
+    Caqti_type.(signkey ->. unit)
       "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \
        expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)"
   in
@@ -64,7 +64,7 @@ let insert_signkey =
 
 let find_denom =
   let req =
-    Caqti_type.(denom_hash ->? denom_data)
+    Caqti_type.(denom_hash ->? denom)
       "SELECT denom_pub, (coin).*, valid_from, expire_withdraw, \
        expire_deposit, expire_legal, (fee_withdraw).*, (fee_deposit).*, \
        (fee_refresh).*, (fee_refund).*, age_mask, denom_pub_hash, master_sig \
@@ -74,7 +74,7 @@ let find_denom =
 
 let get_denominations =
   let req =
-    Caqti_type.(unit ->* denom_data)
+    Caqti_type.(unit ->* denom)
       "SELECT dn.denom_pub, (dn.coin).*, dn.valid_from, dn.expire_withdraw, \
        dn.expire_deposit, dn.expire_legal, (dn.fee_withdraw).*, \
        (dn.fee_deposit).*, (dn.fee_refresh).*, (dn.fee_refund).*, dn.age_mask, \
@@ -87,7 +87,7 @@ let get_denominations =
 (* note: does not update revocation *)
 let insert_denom =
   let req =
-    Caqti_type.(denom_data ->. unit)
+    Caqti_type.(denom ->. unit)
       "INSERT INTO denominations (denom_pub, coin, valid_from, \
        expire_withdraw, expire_deposit, expire_legal, fee_withdraw, \
        fee_deposit, fee_refresh, fee_refund, age_mask, denom_pub_hash, \

src/pg_type.ml

@@ -43,7 +43,7 @@ include struct
   let planchets_hash = HashPlanchetsP.caqti
 end
 
-let signkey_data =
+let signkey =
   let master_sig = Signatures.ExchangeSigningKeyValidity.caqti in
   custom
     ~encode:(fun
@@ -53,7 +53,7 @@ let signkey_data =
       Ok { pub; stamp_start; stamp_expire; stamp_end; master_sig })
     (t5 eddsa_pub time time time master_sig)
 
-let denom_data =
+let denom =
   let master_sig = Signatures.DenominationKeyValidity.caqti in
   custom
     ~encode:(fun

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