diff --git a/src/api.ml b/src/api.ml index 42c98345..a4116cc2 100644 --- a/src/api.ml +++ b/src/api.ml @@ -567,9 +567,9 @@ module GlobalFees = struct history_fee: Amount.t; account_fee: Amount.t; purse_fee: Amount.t; - history_expiration: Timestamp.Span.t; + history_expiration: Time.Relative.t; purse_account_limit: int32; - purse_timeout: Timestamp.Span.t; + purse_timeout: Time.Relative.t; master_sig: GlobalFees.t; } @@ -603,9 +603,9 @@ module GlobalFees = struct |> mem "history_fee" Amount.jsont ~enc:history_fee |> mem "account_fee" Amount.jsont ~enc:account_fee |> mem "purse_fee" Amount.jsont ~enc:purse_fee - |> mem "history_expiration" Timestamp.Span.jsont ~enc:history_expiration + |> mem "history_expiration" Time.Relative.jsont ~enc:history_expiration |> mem "purse_account_limit" Jsont.int32 ~enc:purse_account_limit - |> mem "purse_timeout" Timestamp.Span.jsont ~enc:purse_timeout + |> mem "purse_timeout" Time.Relative.jsont ~enc:purse_timeout |> mem "master_sig" GlobalFees.jsont ~enc:master_sig |> finish end @@ -751,7 +751,7 @@ module ExchangePartnerSetupRequest = struct type t = { partner_base_url: string; partner_pub: EddsaPublicKey.t; - wad_frequency: Timestamp.Span.t; + wad_frequency: Time.Relative.t; master_sig: PartnerConfiguration.t; start_date: Timestamp.t; end_date: Timestamp.t; @@ -781,7 +781,7 @@ module ExchangePartnerSetupRequest = struct map ~kind:"ExchangePartnerSetupRequest" make |> mem "partner_base_url" Jsont.string ~enc:partner_base_url |> mem "partner_pub" EddsaPublicKey.jsont ~enc:partner_pub - |> mem "wad_frequency" Timestamp.Span.jsont ~enc:wad_frequency + |> mem "wad_frequency" Time.Relative.jsont ~enc:wad_frequency |> mem "master_sig" PartnerConfiguration.jsont ~enc:master_sig |> mem "start_date" Timestamp.jsont ~enc:start_date |> mem "end_date" Timestamp.jsont ~enc:end_date @@ -796,7 +796,7 @@ module ExchangePartnerListEntry = struct partner_base_url: string; partner_master_pub: EddsaPublicKey.t; wad_fee: Amount.t; - wad_frequency: Timestamp.Span.t; + wad_frequency: Time.Relative.t; start_date: Timestamp.t; end_date: Timestamp.t; master_sig: WadPartnerSignature.t; @@ -826,7 +826,7 @@ module ExchangePartnerListEntry = struct |> mem "partner_base_url" Jsont.string ~enc:partner_base_url |> mem "partner_master_pub" EddsaPublicKey.jsont ~enc:partner_master_pub |> mem "wad_fee" Amount.jsont ~enc:wad_fee - |> mem "wad_frequency" Timestamp.Span.jsont ~enc:wad_frequency + |> mem "wad_frequency" Time.Relative.jsont ~enc:wad_frequency |> mem "start_date" Timestamp.jsont ~enc:start_date |> mem "end_date" Timestamp.jsont ~enc:end_date |> mem "master_sig" WadPartnerSignature.jsont ~enc:master_sig @@ -1045,7 +1045,7 @@ end module AccountLimit = struct type t = { operation_type: Account_operation.t; - timeframe: Timestamp.Span.t; + timeframe: Time.Relative.t; threshold: Amount.t; soft_limit: bool option; } @@ -1060,7 +1060,7 @@ module AccountLimit = struct let soft_limit v = v.soft_limit in map ~kind:"AccountLimit" make |> mem "operation_type" Account_operation.jsont ~enc:operation_type - |> mem "timeframe" Timestamp.Span.jsont ~enc:timeframe + |> mem "timeframe" Time.Relative.jsont ~enc:timeframe |> mem "threshold" Amount.jsont ~enc:threshold |> opt_mem "soft_limit" Jsont.bool ~enc:soft_limit |> finish @@ -1208,7 +1208,7 @@ module ExchangeKeysResponse = struct kyc_enabled: bool; disable_direct_deposit: bool; master_public_key: EddsaPublicKey.t; - reserve_closing_delay: Timestamp.Span.t; + reserve_closing_delay: Time.Relative.t; wallet_balance_limit_without_kyc: Amount.t list option; hard_limits: AccountLimit.t list; zero_limits: ZeroLimitedOperation.t list; @@ -1335,7 +1335,7 @@ module ExchangeKeysResponse = struct |> mem "kyc_enabled" Jsont.bool ~enc:kyc_enabled |> mem "disable_direct_deposit" Jsont.bool ~enc:disable_direct_deposit |> mem "master_public_key" EddsaPublicKey.jsont ~enc:master_public_key - |> mem "reserve_closing_delay" Timestamp.Span.jsont + |> mem "reserve_closing_delay" Time.Relative.jsont ~enc:reserve_closing_delay |> opt_mem "wallet_balance_limit_without_kyc" (Jsont.list Amount.jsont) ~enc:wallet_balance_limit_without_kyc diff --git a/src/bin_sig.ml b/src/bin_sig.ml index 6caece8b..78383a23 100644 --- a/src/bin_sig.ml +++ b/src/bin_sig.ml @@ -5,7 +5,33 @@ open Bin_type (* TODO keep this? some of those are actuall ecdhe, or union of eddsa|ecdhe *) module Aliases = struct - module TimestampNBO = TimeAbsoluteNBO + module Timestamp = struct + type t = Time.Timestamp.t + + let bin = Time.Timestamp.bin + end + + module TimestampNBO = struct + type t = Time.Timestamp.t + + let bin = Time.Timestamp.bin_nbo + end + + module TimeRelative = struct + type t = Time.Relative.t + + let bin = Time.Relative.bin + end + + module TimeRelativeNBO = struct + type t = Time.Relative.t + + let bin = Time.Relative.bin_nbo + end + + (* TODO rm? *) + module TimeAbsolute = Timestamp + module TimeAbsoluteNBO = TimestampNBO module AmountNBO = struct type t = Amount.t diff --git a/src/bin_type.ml b/src/bin_type.ml index 99a40dd0..ee533245 100644 --- a/src/bin_type.ml +++ b/src/bin_type.ml @@ -57,31 +57,6 @@ module Bytes_64 = struct let bin = Bin.bytes 64 end -(* -- Time -- *) -module TimeAbsolute = struct - type t = Timestamp.t - - let bin = Timestamp.bin -end - -module TimeAbsoluteNBO = struct - type t = Timestamp.t - - let bin = Timestamp.bin_nbo -end - -module TimeRelative = struct - type t = Timestamp.Span.t - - let bin = Timestamp.Span.bin -end - -module TimeRelativeNBO = struct - type t = Timestamp.Span.t - - let bin = Timestamp.Span.bin_nbo -end - (* -- Cryptographic primitives -- *) (* Hashes *) diff --git a/src/config.ml b/src/config.ml index fd098af0..9be285c0 100644 --- a/src/config.ml +++ b/src/config.ml @@ -132,9 +132,9 @@ module Coin = struct type t = { section_name: string; value: Amount.t; - duration_withdraw: Ptime.Span.t; - duration_spend: Ptime.Span.t; - duration_legal: Ptime.Span.t; + duration_withdraw: Time.Relative.t; + duration_spend: Time.Relative.t; + duration_legal: Time.Relative.t; fee_withdraw: Amount.t; fee_deposit: Amount.t; fee_refresh: Amount.t; diff --git a/src/http_keys.ml b/src/http_keys.ml index 58e58594..ba934ecc 100644 --- a/src/http_keys.ml +++ b/src/http_keys.ml @@ -89,9 +89,7 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = 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 = - Some Config.Exchangedb.idle_reserve_expiration_time - 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 @@ -108,16 +106,12 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = denom_data_l in let list_issue_date = - match denom_data_l with [] -> None | v :: _ -> v.Denom_data.stamp_start + match denom_data_l with + | [] -> Time.Timestamp.never + | v :: _ -> v.Denom_data.stamp_start in let denominations = let open Denom_data in - (* TODO time - truncated timestamps to int for comparison *) - let timestamp_to_int = function - | None -> 0 - | Some ptime -> ptime |> Ptime.to_float_s |> Int.of_float - 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 = @@ -126,13 +120,15 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = | Some last_issue_date -> ( match List.find_opt - (fun v -> timestamp_to_int v.stamp_start = last_issue_date) + (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 -> timestamp_to_int v.stamp_start >= last_issue_date) + (fun v -> + Time.Timestamp.compare v.stamp_start last_issue_date >= 0) denom_data_l) in List.map denomgroup_of_denomdata l @@ -141,7 +137,9 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = let signkeys = (* TODO sm-db use database signkey data / verify secmod and database are in sync *) - (*let+ signkey_data_l = Pg.get_active_signkeys db_conn |> unwrap_err_caqti in*) + (* + 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 @@ -192,7 +190,7 @@ let mk_keys ~db_conn (module Sm : Secmod.S) ~last_issue_date = let recoup = (* TODO /recoup *) [] in let* global_fees = - Pg.get_global_fees db_conn ~start_date:Timestamp.epoch |> unwrap_err_caqti + Pg.get_global_fees db_conn ~start_date:Timestamp.zero |> unwrap_err_caqti in let* auditors = (* TODO /auditors/$AUDITOR_PUB/$H_DENOM_PUB *) @@ -246,19 +244,17 @@ 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 last_issue_date = - match Vif.Queries.get req "last_issue_date" with - | [] -> None - | v :: _ -> ( - (* TODO time *) - match float_of_string_opt v with - | None -> - Fmt.failwith - "invalid `?last_issue_date` query param, float_of_string failure" - | Some v -> Some (Int.of_float v)) - in let res = - (*let last_issue_date = Ptime_clock.now () |> Option.some in*) + 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 diff --git a/src/http_management.ml b/src/http_management.ml index dce80c96..469e1c1b 100644 --- a/src/http_management.ml +++ b/src/http_management.ml @@ -176,7 +176,7 @@ module Keys_post = struct let* v = match opt with None -> error | Some v -> Ok v in let check = function false -> error | true -> Ok () in let* () = - check (Timestamp.compare v.stamp_start denom.stamp_start = Some 0) + check (Timestamp.compare v.stamp_start denom.stamp_start = 0) in let* () = check (v.value = denom.value) in let* () = check (v.fee_refund = denom.fee_refund) in @@ -311,8 +311,7 @@ module Auditors = struct Logs.info (fun m -> m "enabled auditor"); () | Some last_date -> - let cmp = Timestamp.compare last_date validity_start |> Option.get in - if cmp > 0 then + if Timestamp.compare last_date validity_start > 0 then Error "database has more recent auditor data for this auditor public key" else @@ -350,8 +349,7 @@ module Auditors_disable = struct match last_date_opt with | None -> Error "auditor not found" | Some last_date -> - let cmp = Timestamp.compare last_date validity_end |> Option.get in - if cmp > 0 then + if Timestamp.compare last_date validity_end > 0 then Error "database has more recent auditor data for this auditor public key" else @@ -452,7 +450,7 @@ module Global_fees = struct } = (* TODO KYC what is kyc_timeout, kyc_fee ? *) - let kyc_timeout = None in + let kyc_timeout = Time.Relative.forever in let kyc_fee = Amount.dummy_value in (* * *) let open Bin_sig.GlobalFees in @@ -562,7 +560,7 @@ module Wire = struct | Some _ -> Error "wire already setup" | None -> (* TODO wire *) - let last_change = Ptime_clock.now () |> Option.some in + let last_change = Timestamp.of_ptime (Ptime_clock.now ()) in let v = ExchangeWireAccount. { diff --git a/src/parse_config.ml b/src/parse_config.ml index f40f1885..cd2c141a 100644 --- a/src/parse_config.ml +++ b/src/parse_config.ml @@ -150,6 +150,7 @@ module Parse_duration = struct let duration = many1 duration_element <* end_of_input + (* TODO put this in Time.Relative *) let dunit_to_seconds u = let rec f = function | `Year -> 365 * f `Day @@ -167,15 +168,14 @@ module Parse_duration = struct fail "ptime_span_of_int64 error: `%Ld` is not a valid ptime span" i | Some ts -> ts - let to_ptime_span t = + let to_time_span t = let acc = List.fold_left (fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit)) 0 t in let acc = Int64.of_int acc in - let ptime = ptime_span_of_int64 acc in - ptime + Time.Relative.of_s acc let parse s : duration_element list = match parse_string ~consume:All duration s with @@ -218,7 +218,7 @@ let yes_no = function let uri s = Uri.of_string s let amount s = s |> Amount.of_string |> unwrap_res -let duration s = Parse_duration.(s |> parse |> to_ptime_span) +let duration s = Parse_duration.(s |> parse |> to_time_span) let ed25519 s = s diff --git a/src/pg.ml b/src/pg.ml index 0d877ba6..f57985e1 100644 --- a/src/pg.ml +++ b/src/pg.ml @@ -62,9 +62,7 @@ let get_active_signkeys = WHERE expire_sign > $1 AND NOT EXISTS (SELECT esk_serial FROM \ signkey_revocations AS skr WHERE esk.esk_serial = skr.esk_serial)" in - fun (module Conn : CONN) -> - let now = Ptime_clock.now () |> Option.some in - Conn.collect_list get_active_signkeys now + fun (module Conn : CONN) ~now -> Conn.collect_list get_active_signkeys now (* note: does not update revocation *) let insert_signkey = diff --git a/src/pg_type.ml b/src/pg_type.ml index 4a1ed95b..f1ed7d77 100644 --- a/src/pg_type.ml +++ b/src/pg_type.ml @@ -17,9 +17,9 @@ let amount : Amount.t t = (* we want to use int64 timestamps, not postgresql built-in timestamp type *) -let ptime : Ptime.t option t = Timestamp.caqti +let ptime : unit t = Caqti_type.unit let time = Timestamp.caqti -let time_span = Timestamp.Span.caqti +let time_span = Time.Relative.caqti let age_mask : int t = Caqti_type.int let rsa_pub = RsaPublicKey.caqti let eddsa_pub = EddsaPublicKey.caqti diff --git a/src/secmod.ml b/src/secmod.ml index 65068174..f19f8aad 100644 --- a/src/secmod.ml +++ b/src/secmod.ml @@ -162,11 +162,12 @@ module Make (Conn : Pg.CONN) = struct | _, _, _ -> error_invalid_state let make_new_signkey () = - let stamp_start = Ptime_clock.now () |> Option.some in - let stamp_expire = - Timestamp.add_span_exn stamp_start - (Some Config.Exchange.signkey_legal_duration) + let start = Time.Absolute.of_ptime (Ptime_clock.now ()) in + let expire = + Time.Absolute.add start Config.Exchange.signkey_legal_duration in + let stamp_start = Time.Timestamp.of_absolute start in + let stamp_expire = Time.Timestamp.of_absolute expire in let stamp_end = stamp_expire in let priv, pub = Mirage_crypto_ec.Ed25519.generate () in let master_sig = None in @@ -194,16 +195,19 @@ module Make (Conn : Pg.CONN) = struct age_restricted= _; } = assert (cipher = `RSA); - let stamp_start = Ptime_clock.now () |> Option.some in + let open Time in + let start = Absolute.of_ptime (Ptime_clock.now ()) in + let stamp_start = Timestamp.of_absolute start in let stamp_expire_withdraw = - Timestamp.add_span_exn stamp_start (Some duration_withdraw) + Timestamp.of_absolute @@ Absolute.add start duration_withdraw in let stamp_expire_deposit = - Timestamp.add_span_exn stamp_start (Some duration_spend) + Timestamp.of_absolute @@ Absolute.add start duration_spend in let stamp_expire_legal = - Timestamp.add_span_exn stamp_start (Some duration_legal) + Timestamp.of_absolute @@ Absolute.add start duration_legal in + let priv, pub = RsaPrivateKey.generate ~bits:rsa_keysize () in let h_pub = Bin_type.DenominationHash.hash (RsaPublicKey.to_octets pub) in let master_sig = None in diff --git a/src/time.ml b/src/time.ml new file mode 100644 index 00000000..3c5af371 --- /dev/null +++ b/src/time.ml @@ -0,0 +1,151 @@ +let uint64_max = Int64.minus_one + +module Relative = struct + type t = Int64.t + + let forever = uint64_max + let zero = 0L + let compare = Int64.unsigned_compare + let min a b = if compare a b < 0 then a else b + let max a b = if compare a b > 0 then a else b + + (* forever if either argument is forever or on overflow; otherwise a + b *) + let add a b = + if a = forever || b = forever then forever + else + let v = Int64.add a b in + if compare v a < 0 then forever else v + + (* zero if a <= b, or forever if a is forever; otherwise a - b *) + let sub a b = + if compare a b <= 0 then zero + else if a = forever then forever + else Int64.sub a b + + let of_s s = + let v = Int64.mul s 1_000_000L in + if Int64.unsigned_div v 1_000_000L <> s then forever else v + + let bin = Bin.neint64 + let bin_nbo = Bin.beint64 + + (* TODO should be in NBO here? *) + let caqti = + let encode v = Ok v in + let decode v = Ok v in + Caqti_type.custom ~encode ~decode Caqti_type.int64 + + (* TODO + reject negative / non-integer values + cap value at 2^53 - 1 inclusive *) + let jsont = + let jsont = + let forever_jsont = + let dec s = + match s with + | "forever" -> forever + | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" + in + let enc _t = "forever" in + Jsont.map ~dec ~enc Jsont.string + in + let num_jsont = Jsont.int64 in + let enc t = if t = forever then forever_jsont else num_jsont in + Jsont.any ~dec_string:forever_jsont ~dec_number:num_jsont ~enc () + in + Jsont.Object.map ~kind:"RelativeTime" Fun.id + |> Jsont.Object.mem "d_us" jsont ~enc:Fun.id + |> Jsont.Object.finish +end + +module Absolute = struct + type t = Int64.t + + let never = uint64_max + let zero = 0L + let compare = Int64.unsigned_compare + let min a b = if compare a b < 0 then a else b + let max a b = if compare a b > 0 then a else b + + (* zero if a >= b; never if b=never; otherwise b - a *) + let diff a b = + if compare a b >= 0 then zero + else if b = never then never + else Int64.sub b a + + (* never if either argument is never/forever or on overflow; otherwise t + d *) + let add t d = + if t = never || d = never then never + else + let v = Int64.add t d in + if compare v t < 0 then never else v + + (* zero if t <= d, or never if t is never; otherwise t - d *) + let sub t d = + if compare t d <= 0 then zero + else if t = never then never + else Int64.sub t d + + let of_s s = + let v = Int64.mul s 1_000_000L in + if Int64.unsigned_div v 1_000_000L <> s then never else v + + let of_ptime v = v |> Ptime.to_float_s |> Int64.of_float |> of_s +end + +module Timestamp = struct + type t = Int64.t + + let never = uint64_max + let zero = 0L + let compare = Int64.unsigned_compare + + (* zero if a >= b; never if b=never; otherwise b - a *) + let diff a b = + if compare a b >= 0 then zero + else if b = never then never + else Int64.sub b a + + let of_s s = + let v = Int64.mul s 1_000_000L in + if Int64.unsigned_div v 1_000_000L <> s then never else v + + let to_s t = + if t = never then None else Some (Int64.unsigned_div t 1_000_000L) + + let of_absolute a = + if a = never then never else Int64.sub a (Int64.unsigned_rem a 1_000_000L) + + let of_ptime v = v |> Absolute.of_ptime |> of_absolute + let bin = Bin.neint64 + let bin_nbo = Bin.beint64 + + let caqti = + let encode v = Ok v in + let decode v = Ok v in + Caqti_type.custom ~encode ~decode Caqti_type.int64 + + let jsont = + let jsont = + let never_jsont = + let dec s = + match s with + | "never" -> never + | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" + in + let enc _t = "never" in + Jsont.map ~dec ~enc Jsont.string + in + let num_jsont = + Jsont.map + ~dec:(fun n -> of_s n) + ~enc:(fun t -> match to_s t with None -> assert false | Some s -> s) + Jsont.int64 + in + let enc t = if t = never then never_jsont else num_jsont in + Jsont.any ~dec_string:never_jsont ~dec_number:num_jsont ~enc () + in + Jsont.Object.map ~kind:"Timestamp" Fun.id + |> Jsont.Object.mem "t_s" jsont ~enc:Fun.id + |> Jsont.Object.finish +end diff --git a/src/time.mli b/src/time.mli new file mode 100644 index 00000000..180df904 --- /dev/null +++ b/src/time.mli @@ -0,0 +1,54 @@ +module Relative : sig + type t + + val forever : t + val zero : t + val compare : t -> t -> int + val min : t -> t -> t + val max : t -> t -> t + val add : t -> t -> t + val sub : t -> t -> t + val of_s : int64 -> t + + (* - *) + val bin : t Bin.t + val bin_nbo : t Bin.t + val caqti : t Caqti_type.t + val jsont : t Jsont.t +end + +module Absolute : sig + type t + + val never : t + val zero : t + val compare : t -> t -> int + val min : t -> t -> t + val max : t -> t -> t + val diff : t -> t -> Relative.t + val add : t -> Relative.t -> t + val sub : t -> Relative.t -> t + val of_s : int64 -> t + val of_ptime : Ptime.t -> t +end + +module Timestamp : sig + type t + + val never : t + val zero : t + val compare : t -> t -> int + val diff : t -> t -> Relative.t + val of_s : int64 -> t + + (* none if t = never *) + val to_s : t -> int64 option + val of_absolute : Absolute.t -> t + val of_ptime : Ptime.t -> t + + (* - *) + val bin : t Bin.t + val bin_nbo : t Bin.t + val caqti : t Caqti_type.t + val jsont : t Jsont.t +end diff --git a/src/timestamp.ml b/src/timestamp.ml index 506d8f2e..1a942758 100644 --- a/src/timestamp.ml +++ b/src/timestamp.ml @@ -1,173 +1 @@ -type t = Ptime.t option -type span = Ptime.Span.t option - -let epoch = Some Ptime.epoch - -let diff a b = - match (a, b) with - | None, _ | _, None -> None - | Some a, Some b -> Some (Ptime.diff a b) - -let add_span_exn t span = - match (t, span) with - | None, _ | _, None -> None - | Some t, Some span -> ( - match Ptime.add_span t span with - | None -> Fmt.failwith "add_span_exn: not in the range [min;max]" - | Some v -> Some v) - -let of_span_exn = function - | None -> None - | Some span -> ( - match Ptime.of_span span with - | None -> Fmt.failwith "of_span_exn: not in the range [min;max]" - | Some p -> Some p) - -(* -- *) - -(* TODO - this doesn't handle "never" value, and truncate time *) -let of_string s = - match Float.of_string_opt s with - | None -> Error "Timestamp.of_string failure: not a float" - | Some v -> ( - match Ptime.of_float_s v with - | None -> Error "Timestamp.of_string failure" - | Some v -> Ok (Some v)) - -let pp fmt t = - match t with - | None -> Fmt.pf fmt {|"never"|} - | Some v -> - let v = Ptime.to_float_s v in - Fmt.pf fmt {|%f|} v - -(* microseconds since the UNIX Epoch, or "never" if None *) -let jsont = - let number_or_never_jsont = - let never = - let dec s = - match s with - | "never" -> None - | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" - in - let enc = function None -> "never" | _ -> assert false in - Jsont.map ~dec ~enc Jsont.string - in - let number = - let dec n = Ptime.of_float_s n in - let enc = function Some n -> Ptime.to_float_s n | _ -> assert false in - Jsont.map ~dec ~enc Jsont.number - in - let enc = function None -> never | Some _ -> number in - Jsont.any ~dec_string:never ~dec_number:number ~enc () - in - let make t = t in - Jsont.Object.map ~kind:"Timestamp" make - |> Jsont.Object.mem "t_s" number_or_never_jsont ~enc:Fun.id - |> Jsont.Object.finish - -let ptime_to_int64 ptime = ptime |> Ptime.to_float_s |> Int64.of_float - -let ptime_of_int64 i = - match Ptime.of_float_s (Int64.to_float i) with - | None -> Fmt.failwith "ptime_of_int64 error: `%Ld` is not a valid ptime" i - | Some ts -> ts - -let encode_int64 = function None -> Int64.max_int | Some p -> ptime_to_int64 p -let decode_int64 i = if i = Int64.max_int then None else Some (ptime_of_int64 i) - -(* UINT64_MAX represents "never". *) -let bin = Bin.map Bin.neint64 decode_int64 encode_int64 -let bin_nbo = Bin.map Bin.beint64 decode_int64 encode_int64 - -let caqti : t Caqti_type.t = - let encode v = Ok (encode_int64 v) in - let decode v = Ok (decode_int64 v) in - Caqti_type.custom ~encode ~decode Caqti_type.int64 - -let compare a b = - match (a, b) with - | None, None -> Some 0 - | None, _ | _, None -> None - | Some a, Some b -> - let a = ptime_to_int64 a in - let b = ptime_to_int64 b in - let c = Int64.compare a b in - Some c - -module Span = struct - type t = span - - (* TODO - this doesn't handle "never" value, and truncate time *) - let of_string s = - match Float.of_string_opt s with - | None -> Error "Timestamp.Span.of_string failure: not a float" - | Some v -> ( - match Ptime.Span.of_float_s v with - | None -> Error "Timestamp.Span.of_string failure" - | Some v -> Ok (Some v)) - - let pp fmt t = - match t with - | None -> Fmt.pf fmt {|"forever"|} - | Some v -> - let v = Ptime.Span.to_float_s v in - Fmt.pf fmt {|%f|} v - - let to_int64 ptime = ptime |> Ptime.Span.to_float_s |> Int64.of_float - - let of_int64 i = - match Ptime.Span.of_float_s (Int64.to_float i) with - | None -> - Fmt.failwith - "ptime_span_of_int64 error: `%Ld` is not a valid ptime span" i - | Some ts -> ts - - let encode_int64 = function None -> Int64.max_int | Some p -> to_int64 p - let decode_int64 i = if i = Int64.max_int then None else Some (of_int64 i) - - (* UINT64_MAX represents "forever" *) - let bin = Bin.map Bin.neint64 decode_int64 encode_int64 - let bin_nbo = Bin.map Bin.beint64 decode_int64 encode_int64 - - let caqti : t Caqti_type.t = - let encode v = Ok (encode_int64 v) in - let decode v = Ok (decode_int64 v) in - Caqti_type.custom ~encode ~decode Caqti_type.int64 - - let jsont = - let number_or_forever_jsont = - let forever = - let dec s = - match s with - | "forever" -> None - | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value" - in - let enc = function None -> "forever" | _ -> assert false in - Jsont.map ~dec ~enc Jsont.string - in - let number = - let dec n = - (* relative time is in us *) - let n = n /. 1_000_000. in - Ptime.Span.of_float_s n - in - let enc = function - | Some span -> - let n = Ptime.Span.to_float_s span in - n *. 1_000_000. - | _ -> assert false - in - Jsont.map ~dec ~enc Jsont.number - in - let enc = function None -> forever | Some _ -> number in - Jsont.any ~dec_string:forever ~dec_number:number ~enc () - in - - let make t_s = t_s in - Jsont.Object.map ~kind:"RelativeTime" make - |> Jsont.Object.mem "t_s" number_or_forever_jsont ~enc:Fun.id - |> Jsont.Object.finish -end +include Time.Timestamp diff --git a/src/timestamp.mli b/src/timestamp.mli deleted file mode 100644 index 5a9276b6..00000000 --- a/src/timestamp.mli +++ /dev/null @@ -1,38 +0,0 @@ -(* TODO time - uhuh! - need to be int64 for binary/pg round trip - really need to fix this module - don't use option for never/forever *) - -type t = Ptime.t option -type span = Ptime.Span.t option - -module Span : sig - type t = span - - val of_string : string -> (t, string) result - val pp : Stdlib.Format.formatter -> t -> unit - - (* - *) - - val jsont : t Jsont.t - val bin : t Bin.t - val bin_nbo : t Bin.t - val caqti : t Caqti_type.t -end - -val epoch : t -val diff : t -> t -> span -val add_span_exn : t -> span -> t -val of_span_exn : span -> t -val compare : t -> t -> int option - -(* used for offline tool argument conversion *) -val of_string : string -> (t, string) result -val pp : Stdlib.Format.formatter -> t -> unit - -(* - *) -val jsont : t Jsont.t -val bin : t Bin.t -val bin_nbo : t Bin.t -val caqti : t Caqti_type.t diff --git a/test/offline_management.sh b/test/offline_management.sh index 867a460b..4883b03f 100755 --- a/test/offline_management.sh +++ b/test/offline_management.sh @@ -16,28 +16,28 @@ dune exec offline -- enable-auditor \ --auditor_url "auditor.example.com" \ --auditor_name "auditor example" \ --auditor_pub $auditor_pub \ ---validity_start "0.0" +--validity_start 0 dune exec offline -- upload --input $b --url "/management/auditors" dune exec offline -- wire-fee \ --output $b \ --wire_method "magic" \ ---fee_start "0.0" \ ---fee_end "99999999.9" \ +--fee_start 0 \ +--fee_end 99999999 \ --closing_fee "EUR:0.0" \ --wire_fee "EUR:0.0" dune exec offline -- upload --input $b --url "/management/wire-fee" dune exec offline -- global-fees \ --output $b \ ---start_date "0.0" \ ---end_date "99999999.9" \ +--start_date 0 \ +--end_date 99999999 \ --history_fee "EUR:0.0" \ --account_fee "EUR:0.0" \ --purse_fee "EUR:0.0" \ ---history_expiration "9999999.0" \ +--history_expiration 9999999 \ --purse_account_limit 1 \ ---purse_timeout "9999999.0" +--purse_timeout 9999999 dune exec offline -- upload --input $b --url "/management/global-fees" rm $a diff --git a/tools/offline.ml b/tools/offline.ml index d749813d..3acceb4d 100644 --- a/tools/offline.ml +++ b/tools/offline.ml @@ -19,12 +19,31 @@ module Arg = struct include Arg let timestamp = - Arg.Conv.make ~docv:"timestamp argument" ~parser:Timestamp.of_string - ~pp:Timestamp.pp () + let parser s = + match int_of_string_opt s with + | None -> Error "not an int" + | Some n -> Ok (Time.Timestamp.of_s (Int64.of_int n)) + in + let pp fmt t = + match Time.Timestamp.to_s t with + | None -> Fmt.pf fmt "never" + | Some s -> Fmt.pf fmt "%Ld" s + in + Arg.Conv.make ~docv:"timestamp argument" ~parser ~pp () let relative_time = - Arg.Conv.make ~docv:"relative time argument" - ~parser:Timestamp.Span.of_string ~pp:Timestamp.Span.pp () + let parser s = + match int_of_string_opt s with + | None -> Error "not an int" + | Some s -> Ok (Time.Relative.of_s (Int64.of_int s)) + in + let pp fmt d = + let t = Time.Timestamp.of_absolute Time.Absolute.(add zero d) in + match Time.Timestamp.to_s t with + | None -> Fmt.pf fmt "never" + | Some s -> Fmt.pf fmt "%Ld" s + in + Arg.Conv.make ~docv:"relative time argument" ~parser ~pp () let b32 = let pp fmt v = Fmt.pf fmt "%s" (B32.encode v) in diff --git a/tools/offline_impl.ml b/tools/offline_impl.ml index 0a505f8d..304f3b54 100644 --- a/tools/offline_impl.ml +++ b/tools/offline_impl.ml @@ -101,7 +101,7 @@ let global_fees ~output ~master_key ~start_date ~end_date ~history_fee let master_sig = let open Bin_sig.GlobalFees in (* TODO KYC *) - let kyc_timeout = None in + let kyc_timeout = Time.Relative.forever in let kyc_fee = Amount.dummy_value in sign_f ~f:(EddsaSignature.sign ~key) {