diff --git a/src/amount.ml b/src/amount.ml index 3caeaf68..7ff74514 100644 --- a/src/amount.ml +++ b/src/amount.ml @@ -1,8 +1,4 @@ -(* TODO - have a currency agnostic amount_lib.ml - and specialize amount.ml to Config.currency?? - - have safe amount arithmetic *) +(* TODO implement operations on amounts *) open Syntax type sign = diff --git a/src/api.ml b/src/api.ml index 062ca181..2a6ea9cc 100644 --- a/src/api.ml +++ b/src/api.ml @@ -85,9 +85,6 @@ module Bytes64 = struct ~decode:of_octets Caqti_type.octets end -(* TODO error response - - use GANA error codes - https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *) module ErrorDetail = struct type t = { code: int; diff --git a/src/crypto.ml b/src/crypto.ml index 5402e12b..5c480085 100644 --- a/src/crypto.ml +++ b/src/crypto.ml @@ -60,7 +60,7 @@ module Binary_format_rsa = struct let* arr = z_array_of_octets ~nb:2 s in match arr with | [| n; e |] -> - let+ pub = Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_err_msg in + let+ pub = Mirage_crypto_pk.Rsa.pub ~n ~e |> unwrap_msg in pub | _ -> assert false @@ -74,7 +74,7 @@ module Binary_format_rsa = struct match arr with | [| e; d; n; p; q; dp; dq; q' |] -> let+ priv = - Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' |> unwrap_err_msg + Mirage_crypto_pk.Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' |> unwrap_msg in priv | _ -> assert false diff --git a/src/headers.ml b/src/headers.ml index fd6ebfc7..6d4a64f7 100644 --- a/src/headers.ml +++ b/src/headers.ml @@ -6,7 +6,8 @@ let accept_header_value = let avail_languages_header_value = Fmt.str "%a" (Fmt.array ~sep:(Fmt.any ", ") Fmt.string) Assets.Language.arr -(* TODO Cohttp raises on invalid *) +(* TODO better headers_lib + Cohttp raises on invalid *) let select_mimetype headers = let opt = Vif.Headers.get headers "accept" in Cohttp.Accept.media_ranges opt diff --git a/src/keys.ml b/src/keys.ml index 6ad2a4f6..66b48442 100644 --- a/src/keys.ml +++ b/src/keys.ml @@ -1,7 +1,6 @@ open Syntax open Crypto -(* TODO better error type *) type 'a result = ('a, string) Result.t module type S = sig @@ -33,8 +32,8 @@ module Make (Conn : Pg.CONN) : S = struct let conn = (module Conn : Pg.CONN) - (* TODO - error "key not found", either: + (* TODO better error + can only be "key not found", either: - we tried to sign with a key that is not ours - key was revoked - bad keyring state *) @@ -49,8 +48,8 @@ module Make (Conn : Pg.CONN) : S = struct | Ok v -> v (* - *) - let find_signkey pub = Pg.find_signkey conn pub |> unwrap_err_caqti - let find_denomination h_pub = Pg.find_denom conn h_pub |> unwrap_err_caqti + let find_signkey pub = Pg.find_signkey conn pub |> unwrap_caqti + let find_denomination h_pub = Pg.find_denom conn h_pub |> unwrap_caqti let warn_key_state = let first = ref true in @@ -65,7 +64,7 @@ module Make (Conn : Pg.CONN) : S = struct let signkeys () : Signkey.t list result = let now = Timestamp.of_ptime @@ Ptime_clock.now () in - let+ l = Pg.get_signkeys conn ~now |> unwrap_err_caqti in + let+ l = Pg.get_signkeys conn ~now |> unwrap_caqti in let missing_l, l = List.partition (fun sk -> Option.is_none @@ Sm_eddsa.find_key sk.Signkey.pub) @@ -79,7 +78,7 @@ module Make (Conn : Pg.CONN) : S = struct l let denominations () = - let+ l = Pg.get_denominations conn () |> unwrap_err_caqti in + let+ l = Pg.get_denominations conn () |> unwrap_caqti in let missing_l, l = List.partition (fun dn -> Option.is_none @@ Sm_rsa.find_key dn.Denomination.h_pub) @@ -201,7 +200,7 @@ module Make (Conn : Pg.CONN) : S = struct let make_future_keys_response () = let now = Timestamp.of_ptime @@ Ptime_clock.now () in (* get keys from database to filter out keys already certified *) - let* sk_db_l = Pg.get_signkeys conn ~now |> unwrap_err_caqti in + let* sk_db_l = Pg.get_signkeys conn ~now |> unwrap_caqti in let sk_ht = Hashtbl.create 0xff in List.iter (fun sk -> Hashtbl.replace sk_ht sk.Signkey.pub ()) sk_db_l; let future_signkeys = @@ -209,7 +208,7 @@ module Make (Conn : Pg.CONN) : S = struct |> List.filter (fun (pub, _) -> not @@ Hashtbl.mem sk_ht pub) |> List.map make_future_sk in - let* dn_db_l = Pg.get_denominations conn () |> unwrap_err_caqti in + let* dn_db_l = Pg.get_denominations conn () |> unwrap_caqti in let dn_ht = Hashtbl.create 0xff in List.iter (fun dn -> Hashtbl.replace dn_ht dn.Denomination.h_pub ()) dn_db_l; let future_denoms = @@ -303,7 +302,7 @@ module Make (Conn : Pg.CONN) : S = struct (* rebuild it *) let future_sk = make_future_sk (pub, (t1, t2)) in let sk = sk_of_future_sk future_sk master_sig in - let+ () = Pg.insert_signkey conn sk |> unwrap_err_caqti in + let+ () = Pg.insert_signkey conn sk |> unwrap_caqti in Logs.info (fun m -> m "certified signkey `%s`" (EddsaPublicKey.to_b32 sk.pub)); ()) @@ -321,7 +320,7 @@ module Make (Conn : Pg.CONN) : S = struct | None -> let future_dn = make_future_dn (h_pub, (section_name, pub, t1)) in let dn = dn_of_future_dn future_dn h_pub master_sig in - let+ () = Pg.insert_denom conn dn |> unwrap_err_caqti in + let+ () = Pg.insert_denom conn dn |> unwrap_caqti in Logs.info (fun m -> m "certified denomination `%s`" (DenominationHash.to_b32 dn.h_pub)); @@ -332,7 +331,7 @@ module Make (Conn : Pg.CONN) : S = struct let* _sk = Option.to_result ~none:"signkey not found" opt in let* () = Sm_eddsa.revoke pub in let+ () = - Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_err_caqti + Pg.insert_signkey_revocation conn pub revoked_sig |> unwrap_caqti in Logs.info (fun m -> m "revoked signkey `%s`" (EddsaPublicKey.to_b32 pub)); () @@ -343,7 +342,7 @@ module Make (Conn : Pg.CONN) : S = struct let* () = Sm_rsa.revoke dn.h_pub in let+ () = Pg.insert_denomination_revocation conn dn.h_pub revoked_sig - |> unwrap_err_caqti + |> unwrap_caqti in Logs.info (fun m -> m "revoked denomination `%s`" (DenominationHash.to_b32 h_pub)); diff --git a/src/mte_info.ml b/src/mte_info.ml index a57d7682..60c5bf59 100644 --- a/src/mte_info.ml +++ b/src/mte_info.ml @@ -41,13 +41,11 @@ let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date = let stefan_lin = Config.stefan_lin in (* type of the asset. "fiat", "crypto", "regional" or "stock". *) let asset_type = "fiat" in - let* accounts = Pg.get_wire_accounts db_conn () |> unwrap_err_caqti in + let* accounts = Pg.get_wire_accounts db_conn () |> unwrap_caqti in let* wire_fees = (* wire_methods? *) let wire_method = "x-taler-bank" in - let+ wire_fees = - Pg.get_wire_fees db_conn ~wire_method |> unwrap_err_caqti - in + let+ wire_fees = Pg.get_wire_fees db_conn ~wire_method |> unwrap_caqti in String_map.singleton wire_method wire_fees in let wads = [] in @@ -111,7 +109,7 @@ let mk_keys ~db_conn (module Keys : Keys.S) ~last_issue_date = let recoup = (* /recoup *) [] in let* global_fees = - Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti + Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_caqti in let* auditors = (* /auditors/$AUDITOR_PUB/$H_DENOM_PUB *) diff --git a/src/mte_management.ml b/src/mte_management.ml index a5c45e55..d289678f 100644 --- a/src/mte_management.ml +++ b/src/mte_management.ml @@ -33,7 +33,7 @@ module Keys_post = struct Logs.info (fun m -> m "POST /management/keys/"); let keys = Vif.Server.device Devices.keys server in let res = - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ keys v in Ok () @@ -59,7 +59,7 @@ module Denom_revoke = struct let keys = Vif.Server.device Devices.keys server in let res = let* h_denom_pub = Crypto.DenominationHash.of_b32 h_denom_pub in - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify keys h_denom_pub v in let* () = do_ keys h_denom_pub v in Ok () @@ -85,7 +85,7 @@ module Signkey_revoke = struct let keys = Vif.Server.device Devices.keys server in let res = let* exchange_pub = Crypto.EddsaPublicKey.of_b32 exchange_pub in - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify keys exchange_pub v in let* () = do_ keys exchange_pub v in Ok () @@ -114,18 +114,18 @@ module Auditors = struct let do_ ~db_conn v = let auditor_pub = v.AuditorSetupMessage.auditor_pub in let validity_start = v.AuditorSetupMessage.validity_start in - let* opt = Pg.find_auditor db_conn auditor_pub |> unwrap_err_caqti in + let* opt = Pg.find_auditor db_conn auditor_pub |> unwrap_caqti in match opt with | None -> let auditor = Auditor.of_setup_message v in - let+ () = Pg.update_auditor db_conn auditor |> unwrap_err_caqti in + let+ () = Pg.update_auditor db_conn auditor |> unwrap_caqti in Logs.info (fun m -> m "enabled auditor"); () | Some auditor -> if Timestamp.compare validity_start auditor.last_change <= 0 then Error "replay detected on enable-auditor" else - let+ () = Pg.update_auditor db_conn auditor |> unwrap_err_caqti in + let+ () = Pg.update_auditor db_conn auditor |> unwrap_caqti in Logs.info (fun m -> m "updated auditor"); () @@ -136,7 +136,7 @@ module Auditors = struct let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -153,7 +153,7 @@ module Auditors_disable = struct let do_ ~db_conn auditor_pub AuditorTeardownMessage.{ master_sig= _; validity_end } = - let* opt = Pg.find_auditor db_conn auditor_pub |> unwrap_err_caqti in + let* opt = Pg.find_auditor db_conn auditor_pub |> unwrap_caqti in match opt with | None -> Error "auditor not found" | Some auditor -> ( @@ -168,7 +168,7 @@ module Auditors_disable = struct let auditor = { auditor with last_change= validity_end; is_active= false } in - let+ () = Pg.update_auditor db_conn auditor |> unwrap_err_caqti in + let+ () = Pg.update_auditor db_conn auditor |> unwrap_caqti in Logs.info (fun m -> m "revoked auditor `%s`" (Crypto.EddsaPublicKey.to_b32 auditor_pub)); @@ -182,7 +182,7 @@ module Auditors_disable = struct let db_conn = Vif.Server.device Devices.db_connection server in let res = let* auditor_pub = Crypto.EddsaPublicKey.of_b32 auditor_pub in - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify keys auditor_pub v in let* () = do_ ~db_conn auditor_pub v in Ok () @@ -215,11 +215,11 @@ module Wire_fee = struct let* wire_fees = Pg.get_wire_fees_by_time db_conn ~wire_method:v.wire_method ~start_date:v.fee_start ~end_date:v.fee_end - |> unwrap_err_caqti + |> unwrap_caqti in match wire_fees with | [] -> - let+ () = Pg.insert_wire_fee db_conn v |> unwrap_err_caqti in + let+ () = Pg.insert_wire_fee db_conn v |> unwrap_caqti in Logs.info (fun m -> m "added wire fee"); () | [ vv ] -> ( @@ -241,7 +241,7 @@ module Wire_fee = struct let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -256,12 +256,11 @@ module Global_fees = struct let* global_fees = let start_date = v.GlobalFees.start_date in let end_date = v.GlobalFees.end_date in - Pg.get_global_fees_by_time db_conn ~start_date ~end_date - |> unwrap_err_caqti + Pg.get_global_fees_by_time db_conn ~start_date ~end_date |> unwrap_caqti in match global_fees with | [] -> - let+ () = Pg.insert_global_fees db_conn v |> unwrap_err_caqti in + let+ () = Pg.insert_global_fees db_conn v |> unwrap_caqti in Logs.info (fun m -> m "added global fees"); () | [ vv ] -> ( @@ -287,7 +286,7 @@ module Global_fees = struct Logs.info (fun m -> m "POST /management/global-fees/"); let db_conn = Vif.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify v in let* () = do_ ~db_conn v in Ok () @@ -362,7 +361,7 @@ module Wire = struct bank_label; priority; } = - let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_err_caqti in + let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_caqti in match opt with | None -> let wire = @@ -380,7 +379,7 @@ module Wire = struct let+ () = Pg.update_wire db_conn ~is_active:true ~last_change:validity_start wire - |> unwrap_err_caqti + |> unwrap_caqti in Logs.info (fun m -> m "added wire method"); () @@ -391,7 +390,7 @@ module Wire = struct let+ () = Pg.update_wire db_conn ~is_active:true ~last_change:validity_start wire - |> unwrap_err_caqti + |> unwrap_caqti in Logs.info (fun m -> m "updated wire method"); () @@ -403,7 +402,7 @@ module Wire = struct let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -420,7 +419,7 @@ module Wire_disable = struct let do_ ~db_conn WireTeardownMessage.{ payto_uri; master_sig_del= _; validity_end } = - let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_err_caqti in + let* opt = Pg.find_wire db_conn ~payto_uri |> unwrap_caqti in match opt with | None -> Error "wire not found" | Some (wire, _is_active, last_change) -> @@ -430,7 +429,7 @@ module Wire_disable = struct let+ () = Pg.update_wire db_conn ~is_active:false ~last_change:validity_end wire - |> unwrap_err_caqti + |> unwrap_caqti in Logs.info (fun m -> m "disabled wire method"); () @@ -442,7 +441,7 @@ module Wire_disable = struct let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -473,15 +472,14 @@ module Drain = struct let do_ ~db_conn v = let* opt = - Pg.find_drain_profit db_conn v.DrainProfitsMessage.wtid - |> unwrap_err_caqti + Pg.find_drain_profit db_conn v.DrainProfitsMessage.wtid |> unwrap_caqti in match opt with | Some _ -> Logs.info (fun m -> m "drain profit message already added to database"); Ok () | None -> - let+ () = Pg.insert_drain_profit db_conn v |> unwrap_err_caqti in + let+ () = Pg.insert_drain_profit db_conn v |> unwrap_caqti in Logs.info (fun m -> m "added drain profit message to database"); () @@ -492,7 +490,7 @@ module Drain = struct let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -522,7 +520,7 @@ module AmlOfficer = struct } let do_ ~db_conn v = - let+ _last_change = Pg.insert_aml_officer db_conn v |> unwrap_err_caqti in + let+ _last_change = Pg.insert_aml_officer db_conn v |> unwrap_caqti in () let jsont = AmlOfficerSetup.jsont @@ -532,7 +530,7 @@ module AmlOfficer = struct let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () @@ -564,7 +562,7 @@ module Partners = struct } let do_ ~db_conn v = - let+ () = Pg.insert_partner db_conn v |> unwrap_err_caqti in + let+ () = Pg.insert_partner db_conn v |> unwrap_caqti in () let jsont = ExchangePartnerSetupRequest.jsont @@ -574,7 +572,7 @@ module Partners = struct let keys = Vif.Server.device Devices.keys server in let db_conn = Vif.Server.device Devices.db_connection server in let res = - let* v = Vif.Request.of_json req |> unwrap_err_msg in + let* v = Vif.Request.of_json req |> unwrap_msg in let* () = verify keys v in let* () = do_ ~db_conn v in Ok () diff --git a/src/pg.ml b/src/pg.ml index eb4c789e..39b29992 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -1,11 +1,6 @@ (* TODO - can we avoid amount tuple boilerplate? - clean up caqti error type - transaction - - GNU Taler use of db-events? - it seems caqti/pgx does not support it *) + GNU Taler use of db-events? it seems caqti/pgx does not support it *) module type CONN = Caqti_miou.CONNECTION @@ -162,7 +157,7 @@ let get_auditor_keys = in fun (module Conn : CONN) -> let open Syntax in - let* l = Conn.collect_list req () |> unwrap_err_caqti in + let* l = Conn.collect_list req () |> unwrap_caqti in let ht = Hashtbl.create 0xff in List.iter (fun (pub, url, name, denom_pub_h, auditor_sig) -> diff --git a/src/respond.ml b/src/respond.ml index 17f67039..a7780c36 100644 --- a/src/respond.ml +++ b/src/respond.ml @@ -1,6 +1,3 @@ -(* 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 diff --git a/src/secmod_eddsa.ml b/src/secmod_eddsa.ml index 6cf9ac1e..12d1041e 100644 --- a/src/secmod_eddsa.ml +++ b/src/secmod_eddsa.ml @@ -46,13 +46,13 @@ let key_fpath k = let read_key fpath = Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath); - let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + let* data = Bos.OS.File.read fpath |> unwrap_msg in EddsaPrivateKey.of_octets data let write_eddsa fpath priv = Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath); let data = EddsaPrivateKey.to_octets priv in - Bos.OS.File.write fpath data |> unwrap_err_msg + Bos.OS.File.write fpath data |> unwrap_msg let write_key k = write_eddsa (key_fpath k) k.priv @@ -66,16 +66,14 @@ let delete_file fpath = Fpath.pp fpath in Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath); - let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in + let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_msg in () let get_key_dir_contents dir = - let* dir = Fpath.of_string dir |> unwrap_err_msg in - let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_err_msg in + let* dir = Fpath.of_string dir |> unwrap_msg in + let* b = Bos.OS.Dir.create ~mode:0o700 dir |> unwrap_msg in if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir); - let+ l = - Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_err_msg - in + let+ l = Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir |> unwrap_msg in List.map Fpath.normalize l (* -- *) @@ -103,7 +101,7 @@ let split_in_periodes ~start ~end_ = in go acc start end_ -(* TODO do not exceed lookahead (probably more important...) *) +(* TODO do not exceed lookahead *) (* try to not generate keys with validity start in the past *) let gen_additional_keys_until_lookahead ~now l = let start = @@ -118,11 +116,10 @@ let gen_additional_keys_until_lookahead ~now l = let new_keys = List.map (fun (t1, t2) -> gen_key t1 t2) periodes in new_keys -(* TODO config *) let sm_key_fpath = Result.get_ok @@ - let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in + let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_msg in Fpath.normalize fpath (* we load sm_key separately @@ -221,5 +218,5 @@ end - more checks - sign: check timestamps before signing - schedule tasks - - !lock + - ! use lock *) diff --git a/src/secmod_rsa.ml b/src/secmod_rsa.ml index 698c8de4..edc70476 100644 --- a/src/secmod_rsa.ml +++ b/src/secmod_rsa.ml @@ -80,22 +80,22 @@ let key_fpath k = let read_eddsa fpath = Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath); - let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + let* data = Bos.OS.File.read fpath |> unwrap_msg in EddsaPrivateKey.of_octets data let read_rsa fpath = Log.debug (fun m -> m "reading key file `%a`" Fpath.pp fpath); - let* data = Bos.OS.File.read fpath |> unwrap_err_msg in + let* data = Bos.OS.File.read fpath |> unwrap_msg in RsaPrivateKey.of_octets data let write_eddsa fpath priv = Log.debug (fun m -> m "writing key file `%a`" Fpath.pp fpath); let data = EddsaPrivateKey.to_octets priv in - Bos.OS.File.write fpath data |> unwrap_err_msg + Bos.OS.File.write fpath data |> unwrap_msg let write_rsa fpath priv = let data = RsaPrivateKey.to_octets priv in - Bos.OS.File.write fpath data |> unwrap_err_msg + Bos.OS.File.write fpath data |> unwrap_msg let write_key k = write_rsa (key_fpath k) k.priv @@ -109,14 +109,14 @@ let delete_file fpath = Fpath.pp fpath in Log.debug (fun m -> m "delete key file `%a`" Fpath.pp fpath); - let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_err_msg in + let+ () = Bos.OS.File.delete ~must_exist:true fpath |> unwrap_msg in () let get_key_dir_contents dir_fpath = - let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_err_msg in + let* b = Bos.OS.Dir.create ~mode:0o700 dir_fpath |> unwrap_msg in if b then Log.info (fun m -> m "created directory `%a`" Fpath.pp dir_fpath); let+ l = - Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_err_msg + Bos.OS.Dir.contents ~dotfiles:false ~rel:false dir_fpath |> unwrap_msg in List.map Fpath.normalize l @@ -168,7 +168,7 @@ let gen_additional_keys_until_lookahead ~now ~section_name l = let sm_key_fpath = Result.get_ok @@ - let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_err_msg in + let+ fpath = Fpath.of_string Cfg.sm_priv_key |> unwrap_msg in Fpath.normalize fpath (* we load sm_key separately diff --git a/src/syntax.ml b/src/syntax.ml index 7db544ca..5b4937bc 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -1,10 +1,13 @@ let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e let ( let+ ) o f = match o with Ok v -> Ok (f v) | Error _ as e -> e -(* TODO use polymorphic variant for errors *) -let unwrap_err_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v +(* TODO better errors + use polymorphic variant for errors + use GANA error codes: + https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *) +let unwrap_msg o = match o with Error (`Msg e) -> Error e | Ok v -> Ok v -let unwrap_err_caqti o = +let unwrap_caqti o = match o with Error err -> Fmt.error "%a" Caqti_error.pp err | Ok v -> Ok v let list_iter f l = diff --git a/src/time.mli b/src/time.mli index ca3322c4..7955f822 100644 --- a/src/time.mli +++ b/src/time.mli @@ -50,7 +50,6 @@ module Timestamp : sig val of_absolute : TimeAbsolute.t -> t val of_ptime : Ptime.t -> t - (* TODO add pp *) (* - *) val bin : t Bin.t val caqti : t Caqti_type.t diff --git a/test/management.sh b/test/management.sh index af0d57a6..1a13d8bf 100755 --- a/test/management.sh +++ b/test/management.sh @@ -10,6 +10,8 @@ auditor_pub="A17JXR3E6J4CXDPYT7S1H25PGJ3ABS26TQ38654QCX0TB59RPMF0" master_key="./default/master_offline_private_key" zero_kudos="KUDOS:0.0" +# TODO launch mte.exe and kill it a then end with its PID + offline_tool() { dune exec offline -- "$@" > /dev/null } diff --git a/test/test.ml b/test/test.ml index b2462f9b..53de5106 100644 --- a/test/test.ml +++ b/test/test.ml @@ -34,8 +34,6 @@ let () = check Timestamp.jsont {|{"t_s": "never"}|}; check_bad Timestamp.jsont {|{"t_s": "123456780"}|}; check_bad Timestamp.jsont {|{"t_s": "agagou"}|}; - - (* TODO CS not implemented *) check_bad DenominationKey.jsont {|{"cipher": "CS", "age_mask": 18, "cs_pub": "ouhagag"}|}; () diff --git a/test/validate_response.ml b/test/validate_response.ml index dda024b0..77a3c718 100644 --- a/test/validate_response.ml +++ b/test/validate_response.ml @@ -12,8 +12,8 @@ let keys content = else Fmt.error "version incompatible" in - (* TODO validate ExchangeWireAccount - need hash over json *) + (* TODO json hash + validate wire *) let* () = let open AggregateTransferFee in v.wire_fees @@ -52,7 +52,7 @@ let keys content = match opt with | None -> Fmt.error "exchange_pub is not in signkeys list" | Some _sk -> - (* TODO add a --now option? + (* todo add a --now option if we want to validate timestamps let now = Timestamp.of_ptime (Ptime_clock.now ()) in if Signkey.is_valid_at ~timestamp:now sk then Ok () else Fmt.error "exchange_pub is not valid at the current time" @@ -129,7 +129,7 @@ let keys_cmd = @@ let+ input = input in let* content = - Result.bind (Fpath.of_string input) Bos.OS.File.read |> unwrap_err_msg + Result.bind (Fpath.of_string input) Bos.OS.File.read |> unwrap_msg in keys content diff --git a/tools/offline_impl.ml b/tools/offline_impl.ml index b327b99f..d3ab9e41 100644 --- a/tools/offline_impl.ml +++ b/tools/offline_impl.ml @@ -145,10 +145,10 @@ end (* -- *) -let read_file fname = Bos.OS.File.read (Fpath.v fname) |> unwrap_err_msg +let read_file fname = Bos.OS.File.read (Fpath.v fname) |> unwrap_msg let write_file fname content = - Bos.OS.File.write (Fpath.v fname) content |> unwrap_err_msg + Bos.OS.File.write (Fpath.v fname) content |> unwrap_msg let read_master_key_file filename = let* master_key = read_file filename in @@ -167,7 +167,7 @@ let download ~output ~url = % "-X" % "GET" % url) - |> unwrap_err_msg + |> unwrap_msg let upload ~input ~url = let open Bos in @@ -185,7 +185,7 @@ let upload ~input ~url = % "--data" % ("@" ^ input) % url) - |> unwrap_err_msg + |> unwrap_msg let setup ~output ~output_pubkey = Mirage_crypto_rng_unix.use_default ();