better relative time

src/api.ml

@@ -85,36 +85,6 @@ end = struct
   let jsont = B32.jsont
 end
 
-module RelativeTime = struct
-  type t =
-    | Microseconds of float
-    | Forever
-
-  let number_or_forever_jsont =
-    let forever =
-      let dec s =
-        match s with
-        | "forever" -> Forever
-        | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
-      in
-      let enc = function Forever -> "forever" | _ -> assert false in
-      Jsont.map ~dec ~enc Jsont.string
-    in
-    let number =
-      let dec n = Microseconds n in
-      let enc = function Microseconds n -> n | _ -> assert false in
-      Jsont.map ~dec ~enc Jsont.number
-    in
-    let enc = function Forever -> forever | Microseconds _ -> number in
-    Jsont.any ~dec_string:forever ~dec_number:number ~enc ()
-
-  let jsont =
-    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
-
 (* TODO error response
    - use GANA error codes
      https://git.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *)
@@ -613,9 +583,9 @@ module GlobalFees = struct
     history_fee: Amount.t;
     account_fee: Amount.t;
     purse_fee: Amount.t;
-    history_expiration: RelativeTime.t;
+    history_expiration: Timestamp.Span.t;
     purse_account_limit: int32;
-    purse_timeout: RelativeTime.t;
+    purse_timeout: Timestamp.Span.t;
     master_sig: GlobalFees.t;
   }
 
@@ -649,9 +619,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" RelativeTime.jsont ~enc:history_expiration
+    |> mem "history_expiration" Timestamp.Span.jsont ~enc:history_expiration
     |> mem "purse_account_limit" Jsont.int32 ~enc:purse_account_limit
-    |> mem "purse_timeout" RelativeTime.jsont ~enc:purse_timeout
+    |> mem "purse_timeout" Timestamp.Span.jsont ~enc:purse_timeout
     |> mem "master_sig" GlobalFees.jsont ~enc:master_sig
     |> finish
 end
@@ -797,7 +767,7 @@ module ExchangePartnerSetupRequest = struct
   type t = {
     partner_base_url: string;
     partner_pub: EddsaPublicKey.t;
-    wad_frequency: RelativeTime.t;
+    wad_frequency: Timestamp.Span.t;
     master_sig: PartnerConfiguration.t;
     start_date: Timestamp.t;
     end_date: Timestamp.t;
@@ -827,7 +797,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" RelativeTime.jsont ~enc:wad_frequency
+    |> mem "wad_frequency" Timestamp.Span.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
@@ -842,7 +812,7 @@ module ExchangePartnerListEntry = struct
     partner_base_url: string;
     partner_master_pub: EddsaPublicKey.t;
     wad_fee: Amount.t;
-    wad_frequency: RelativeTime.t;
+    wad_frequency: Timestamp.Span.t;
     start_date: Timestamp.t;
     end_date: Timestamp.t;
     master_sig: WadPartnerSignature.t;
@@ -872,7 +842,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" RelativeTime.jsont ~enc:wad_frequency
+    |> mem "wad_frequency" Timestamp.Span.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
@@ -1091,7 +1061,7 @@ end
 module AccountLimit = struct
   type t = {
     operation_type: Account_operation.t;
-    timeframe: RelativeTime.t;
+    timeframe: Timestamp.Span.t;
     threshold: Amount.t;
     soft_limit: bool option;
   }
@@ -1106,7 +1076,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" RelativeTime.jsont ~enc:timeframe
+    |> mem "timeframe" Timestamp.Span.jsont ~enc:timeframe
     |> mem "threshold" Amount.jsont ~enc:threshold
     |> opt_mem "soft_limit" Jsont.bool ~enc:soft_limit
     |> finish
@@ -1254,7 +1224,7 @@ module ExchangeKeysResponse = struct
     kyc_enabled: bool;
     disable_direct_deposit: bool;
     master_public_key: EddsaPublicKey.t;
-    reserve_closing_delay: RelativeTime.t;
+    reserve_closing_delay: Timestamp.Span.t;
     wallet_balance_limit_without_kyc: Amount.t list option;
     hard_limits: AccountLimit.t list;
     zero_limits: ZeroLimitedOperation.t list;
@@ -1381,7 +1351,8 @@ 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" RelativeTime.jsont ~enc:reserve_closing_delay
+    |> mem "reserve_closing_delay" Timestamp.Span.jsont
+         ~enc:reserve_closing_delay
     |> opt_mem "wallet_balance_limit_without_kyc" (Jsont.list Amount.jsont)
          ~enc:wallet_balance_limit_without_kyc
     |> mem "hard_limits" (Jsont.list AccountLimit.jsont) ~enc:hard_limits

src/bin_sig.ml

@@ -5,11 +5,7 @@ open Bin_type
 (* TODO keep this?
    some of those are actuall ecdhe, or union of eddsa|ecdhe *)
 module Aliases = struct
-  module TimestampNBO : Time_S = struct
+  module TimestampNBO = TimeAbsoluteNBO
-    type t = Timestamp.t
-
-    let bin = Timestamp.bin_nbo
-  end
 
   module AmountNBO = struct
     type t = Amount.t
@@ -397,7 +393,7 @@ module GlobalFees = struct
           })
       |+ Purpose.field purpose
       |+ field TimeAbsoluteNBO.bin (fun t -> t.start_date)
-      |+ field TimeRelativeNBO.bin (fun t -> t.end_date)
+      |+ field TimeAbsoluteNBO.bin (fun t -> t.end_date)
       |+ field TimeRelativeNBO.bin (fun t -> t.purse_timeout)
       |+ field TimeRelativeNBO.bin (fun t -> t.kyc_timeout)
       |+ field TimeRelativeNBO.bin (fun t -> t.history_expiration)

src/bin_type.ml

@@ -58,28 +58,29 @@ module Bytes_64 = struct
 end
 
 (* -- Time -- *)
-module type Time_S = sig
+module TimeAbsolute = struct
-  type t = Timestamp.t
-
-  val bin : t Bin.t
-end
-
-module TIME : Time_S = struct
   type t = Timestamp.t
 
   let bin = Timestamp.bin
 end
 
-module TIME_NBO : Time_S = struct
+module TimeAbsoluteNBO = struct
   type t = Timestamp.t
 
   let bin = Timestamp.bin_nbo
 end
 
-module TimeAbsolute : Time_S = TIME
+module TimeRelative = struct
-module TimeAbsoluteNBO : Time_S = TIME_NBO
+  type t = Timestamp.Span.t
-module TimeRelative : Time_S = TIME
+
-module TimeRelativeNBO : Time_S = TIME_NBO
+  let bin = Timestamp.Span.bin
+end
+
+module TimeRelativeNBO = struct
+  type t = Timestamp.Span.t
+
+  let bin = Timestamp.Span.bin_nbo
+end
 
 (* -- Cryptographic primitives -- *)
 

src/management.ml

@@ -27,9 +27,7 @@ let mk_future_denom ~sm_denom_priv
     let h_denom_pub = h_pub in
     let h_section_name = Bin_type.Hash_64_cstr.hash section_name in
     let anchor_time = stamp_start in
-    let duration_withdraw =
+    let duration_withdraw = Timestamp.diff stamp_start stamp_expire_withdraw in
-      Timestamp.diff stamp_start stamp_expire_withdraw |> Timestamp.of_span_exn
-    in
     sign ~key:sm_denom_priv
       { h_denom_pub; h_section_name; anchor_time; duration_withdraw }
   in
@@ -56,9 +54,7 @@ let mk_future_signkey ~sm_signkey_priv
     let open Bin_sig.SigningKeyAnnouncement in
     let exchange_pub = pub in
     let anchor_time = stamp_start in
-    let duration =
+    let duration = Timestamp.diff stamp_start stamp_expire in
-      Timestamp.diff stamp_start stamp_expire |> Timestamp.of_span_exn
-    in
     sign ~key:sm_signkey_priv { exchange_pub; anchor_time; duration }
   in
   FutureSignKey.
@@ -350,19 +346,17 @@ let verify_global_fees
         history_fee;
         account_fee;
         purse_fee;
-        history_expiration= _;
+        history_expiration;
         purse_account_limit;
-        purse_timeout= _;
+        purse_timeout;
         master_sig;
       } =
-  (* TODO time..... *)
+  (* TODO what is kyc_timeout, kyc_fee ? *)
-  let dummy_relative_time = None in
   let dummy_amount =
     Amount.make ~sign:None ~currency:"EUR" ~value:0_L ~fraction:0_l
     |> Result.get_ok
   in
-  (* TODO what is kyc_timeout, kyc_fee ? *)
+  let kyc_timeout = None in
-  let kyc_timeout = dummy_relative_time in
   let kyc_fee = dummy_amount in
   (* * *)
   let open Bin_sig.GlobalFees in
@@ -370,9 +364,9 @@ let verify_global_fees
     {
       start_date;
       end_date;
-      purse_timeout= dummy_relative_time;
+      purse_timeout;
       kyc_timeout;
-      history_expiration= dummy_relative_time;
+      history_expiration;
       history_fee;
       kyc_fee;
       account_fee;

src/pg.ml

@@ -27,6 +27,7 @@ module Caqti_type = struct
      not postgresql built-in timestamp type *)
   let ptime : Ptime.t option t = Timestamp.caqti
   let time = Timestamp.caqti
+  let time_span = Timestamp.Span.caqti
   let age_mask : int t = Caqti_type.int
   let rsa_pub = RsaPublicKey.caqti
   let eddsa_pub = EddsaPublicKey.caqti
@@ -250,7 +251,9 @@ let insert_wire_fee =
 
 let lookup_global_fee_by_time =
   let lookup_global_fee_by_time =
-    let global_fee = Caqti_type.(t6 amount amount amount time time int32) in
+    let global_fee =
+      Caqti_type.(t6 amount amount amount time_span time_span int32)
+    in
     Caqti_type.(t2 time time ->? global_fee)
       "SELECT (history_fee).*, (account_fee).*, (purse_fee).*, purse_timeout, \
        history_expiration, purse_account_limit FROM global_fee WHERE end_date \
@@ -263,7 +266,8 @@ let insert_global_fee =
   let insert_global_fee =
     let master_sig = Bin_sig.GlobalFees.caqti in
     Caqti_type.(
-      t9 time time amount amount amount time time int32 master_sig ->. unit)
+      t9 time time amount amount amount time_span time_span int32 master_sig
+      ->. unit)
       "INSERT INTO global_fee (start_date, end_date, history_fee, account_fee, \
        purse_fee, purse_timeout, history_expiration, purse_account_limit, \
        master_sig) VALUES ($1, $2, ($3,$4), ($5,$6), ($7,$8), $9, $10, $11, \
@@ -277,15 +281,12 @@ let insert_global_fee =
         history_fee;
         account_fee;
         purse_fee;
-        history_expiration= _;
+        history_expiration;
         purse_account_limit;
-        purse_timeout= _;
+        purse_timeout;
         master_sig;
       }
   ->
-    (* TODO time *)
-    let purse_timeout = None in
-    let history_expiration = None in
     Conn.exec insert_global_fee
       ( start_date,
         end_date,

src/timestamp.ml

@@ -48,7 +48,6 @@ let jsont =
   |> Jsont.Object.mem "t_s" number_or_never_jsont ~enc:Fun.id
   |> Jsont.Object.finish
 
-(* TODO exn *)
 let ptime_to_int64 ptime = ptime |> Ptime.to_float_s |> Int64.of_float
 
 let ptime_of_int64 i =
@@ -77,3 +76,62 @@ let compare a b =
       let b = ptime_to_int64 b in
       let c = Int64.compare a b in
       Some c
+
+module Span = struct
+  type t = span
+
+  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

@@ -7,6 +7,15 @@
 type t = Ptime.t option
 type span = Ptime.Span.t option
 
+module Span : sig
+  type t = span
+
+  val jsont : t Jsont.t
+  val bin : t Bin.t
+  val bin_nbo : t Bin.t
+  val caqti : t Caqti_type.t
+end
+
 val diff : t -> t -> span
 val add_span_exn : t -> span -> t
 val of_span_exn : span -> t
@@ -16,4 +25,4 @@ val compare : t -> t -> int option
 val jsont : t Jsont.t
 val bin : t Bin.t
 val bin_nbo : t Bin.t
-val caqti : Ptime.t option Caqti_type.t
+val caqti : t Caqti_type.t

tools/offline_sig.ml

@@ -75,9 +75,7 @@ let verify_future_signkey ~sm_signkey_pub
       { key; stamp_start; stamp_expire; stamp_end= _; signkey_secmod_sig } =
   let exchange_pub = key in
   let anchor_time = stamp_start in
-  let duration =
+  let duration = Timestamp.diff stamp_start stamp_expire in
-    Timestamp.diff stamp_start stamp_expire |> Timestamp.of_span_exn
-  in
   let open Bin_sig.SigningKeyAnnouncement in
   verify ~key:sm_signkey_pub signkey_secmod_sig
     { exchange_pub; anchor_time; duration }
@@ -103,9 +101,7 @@ let verify_future_denom ~sm_denom_pub
   in
   let h_section_name = Hash_64_cstr.hash section_name in
   let anchor_time = stamp_start in
-  let duration_withdraw =
+  let duration_withdraw = Timestamp.diff stamp_start stamp_expire_withdraw in
-    Timestamp.diff stamp_start stamp_expire_withdraw |> Timestamp.of_span_exn
-  in
   let open Bin_sig.DenominationKeyAnnouncement in
   verify ~key:sm_denom_pub denom_secmod_sig
     { h_denom_pub; h_section_name; anchor_time; duration_withdraw }