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

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

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

src/config.ml

@@ -132,9 +132,9 @@ module Coin = struct
   type t = {
     section_name: string;
     value: Amount.t;
-    duration_withdraw: Ptime.Span.t;
+    duration_withdraw: Time.Relative.t;
-    duration_spend: Ptime.Span.t;
+    duration_spend: Time.Relative.t;
-    duration_legal: Ptime.Span.t;
+    duration_legal: Time.Relative.t;
     fee_withdraw: Amount.t;
     fee_deposit: Amount.t;
     fee_refresh: Amount.t;

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 =
+  let reserve_closing_delay = Config.Exchangedb.idle_reserve_expiration_time in
-    Some 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

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 Timestamp.compare last_date validity_start > 0 then
-        if cmp > 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 Timestamp.compare last_date validity_end > 0 then
-        if cmp > 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.
             {

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
+    Time.Relative.of_s acc
-    ptime
 
   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

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) ->
+  fun (module Conn : CONN) ~now -> Conn.collect_list get_active_signkeys now
-    let now = Ptime_clock.now () |> Option.some in
-    Conn.collect_list get_active_signkeys now
 
 (* note: does not update revocation *)
 let insert_signkey =

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

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 start = Time.Absolute.of_ptime (Ptime_clock.now ()) in
-    let stamp_expire =
+    let expire =
-      Timestamp.add_span_exn stamp_start
+      Time.Absolute.add start Config.Exchange.signkey_legal_duration
-        (Some 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

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

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

src/timestamp.ml

@@ -1,173 +1 @@
-type t = Ptime.t option
+include Time.Timestamp
-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

src/timestamp.mli

@@ -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

test/offline_management.sh

@@ -6,6 +6,7 @@ a="tmp_a.json"
 b="tmp_b.json"
 
 auditor_pub=$(<"./data/auditor_public_key")
+zero_euro="EUR:0.0"
 
 dune exec offline -- download --output $a
 dune exec offline -- sign --input $a --output $b
@@ -16,28 +17,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_start 0 \
---fee_end "99999999.9" \
+--fee_end 99999999 \
---closing_fee "EUR:0.0" \
+--closing_fee $zero_euro \
---wire_fee "EUR:0.0"
+--wire_fee $zero_euro
 dune exec offline -- upload --input $b --url "/management/wire-fee"
 
 dune exec offline -- global-fees \
 --output $b \
---start_date "0.0" \
+--start_date 0 \
---end_date "99999999.9" \
+--end_date 99999999 \
---history_fee "EUR:0.0" \
+--history_fee $zero_euro \
---account_fee "EUR:0.0" \
+--account_fee $zero_euro \
---purse_fee "EUR:0.0" \
+--purse_fee $zero_euro \
---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

tools/offline.ml

@@ -18,13 +18,34 @@ open Offline_impl
 module Arg = struct
   include Arg
 
+  (* in seconds *)
   let timestamp =
-    Arg.Conv.make ~docv:"timestamp argument" ~parser:Timestamp.of_string
+    let parser s =
-      ~pp:Timestamp.pp ()
+      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 ()
 
+  (* in seconds *)
   let relative_time =
-    Arg.Conv.make ~docv:"relative time argument"
+    let parser s =
-      ~parser:Timestamp.Span.of_string ~pp:Timestamp.Span.pp ()
+      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

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