add timestamp.ml

WIP better time
  revert this?

src/api.ml

@@ -44,45 +44,6 @@ end = struct
   let jsont = Jsont.of_of_string ~kind:"HashCode" B32.decode ~enc:B32.encode
 end
 
-module Timestamp = struct
-  type t =
-    | Seconds of float
-    | Never
-
-  (* TODO time
-     - time.ml
-     - check this
-     - what value for never?
-     - better way for conversion to bin_types? *)
-  let to_int64 t = match t with Never -> 0_L | Seconds v -> Int64.of_float v
-  let to_ptime t = Util.ptime_of_int64 @@ to_int64 t
-  let of_ptime p = Seconds (Ptime.to_float_s p)
-
-  let number_or_never_jsont =
-    let never =
-      let dec s =
-        match s with
-        | "never" -> Never
-        | _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
-      in
-      let enc = function Never -> "never" | _ -> assert false in
-      Jsont.map ~dec ~enc Jsont.string
-    in
-    let number =
-      let dec n = Seconds n in
-      let enc = function Seconds n -> n | _ -> assert false in
-      Jsont.map ~dec ~enc Jsont.number
-    in
-    let enc = function Never -> never | Seconds _ -> number in
-    Jsont.any ~dec_string:never ~dec_number:number ~enc ()
-
-  let jsont =
-    let make t_s = t_s in
-    Jsont.Object.map ~kind:"Timestamp" make
-    |> Jsont.Object.mem "t_s" number_or_never_jsont ~enc:Fun.id
-    |> Jsont.Object.finish
-end
-
 module RelativeTime = struct
   type t =
     | Microseconds of float

src/bin_type.ml

@@ -58,39 +58,29 @@ module Bytes_64 = struct
   let bin = Bin.bytes 64
 end
 
-(* microseconds since the UNIX Epoch
-   UINT64_MAX represents "never" *)
-module INT64 = struct
-  type t = int64
-
-  let bin = Bin.neint64
-  let of_ptime v = Util.ptime_to_int64 v
-  let of_int64 i = i
-end
-
-module INT64_NBO = struct
-  type t = int64
-
-  let bin = Bin.beint64
-  let of_ptime v = Util.ptime_to_int64 v
-  let of_int64 i = i
-end
-
 (* -- Time -- *)
 module type Time_S = sig
-  type t
+  type t = Timestamp.t
 
   val bin : t Bin.t
-  val of_ptime : Ptime.t -> t
-  val of_int64 : int64 -> t
 end
 
-module TimeAbsolute : Time_S = INT64
+module TIME : Time_S = struct
-module TimeAbsoluteNBO : Time_S = INT64_NBO
+  type t = Timestamp.t
-module TimeRelative : Time_S = INT64
+
-module TimeRelativeNBO : Time_S = INT64_NBO
+  let bin = Timestamp.bin
-module Timestamp : Time_S = INT64
+end
-module TimestampNBO : Time_S = INT64_NBO
+
+module TIME_NBO : Time_S = struct
+  type t = Timestamp.t
+
+  let bin = Timestamp.bin_nbo
+end
+
+module TimeAbsolute : Time_S = TIME
+module TimeAbsoluteNBO : Time_S = TIME_NBO
+module TimeRelative : Time_S = TIME
+module TimeRelativeNBO : Time_S = TIME_NBO
 
 (* -- Cryptographic primitives -- *)
 
@@ -238,6 +228,12 @@ end
 (* TODO keep this?
    some of those are actuall ecdhe, or union of eddsa|ecdhe *)
 module Aliases = struct
+  module TimestampNBO : Time_S = struct
+    type t = Timestamp.t
+
+    let bin = Timestamp.bin_nbo
+  end
+
   module AmountNBO = struct
     type t = Amount.t
 

src/denomination.ml

@@ -4,10 +4,10 @@ type t = {
   pub: RsaPublicKey.t;
   section_name: string;
   value: Amount.t;
-  stamp_start: Ptime.t;
+  stamp_start: Timestamp.t;
-  stamp_expire_withdraw: Ptime.t;
+  stamp_expire_withdraw: Timestamp.t;
-  stamp_expire_deposit: Ptime.t;
+  stamp_expire_deposit: Timestamp.t;
-  stamp_expire_legal: Ptime.t;
+  stamp_expire_legal: Timestamp.t;
   fee_withdraw: Amount.t;
   fee_deposit: Amount.t;
   fee_refresh: Amount.t;
@@ -36,14 +36,16 @@ let make
       Config.Coin.t) =
   assert (cipher = `RSA);
 
-  let stamp_start = Ptime_clock.now () in
+  let stamp_start = Ptime_clock.now () |> Option.some in
   let stamp_expire_withdraw =
-    Util.ptime_add_span_exn stamp_start duration_withdraw
+    Timestamp.add_span_exn stamp_start (Some duration_withdraw)
   in
   let stamp_expire_deposit =
-    Util.ptime_add_span_exn stamp_start duration_spend
+    Timestamp.add_span_exn stamp_start (Some duration_spend)
+  in
+  let stamp_expire_legal =
+    Timestamp.add_span_exn stamp_start (Some duration_legal)
   in
-  let stamp_expire_legal = Util.ptime_add_span_exn stamp_start duration_legal in
 
   let open Mirage_crypto_pk.Rsa in
   let priv = generate ~bits:rsa_keysize () in

src/management.ml

@@ -28,11 +28,9 @@ let mk_future_denom denom_key_signf
     let open Bin_signature.DenominationKeyAnnouncementPS in
     let h_denom_pub = h_pub in
     let h_section_name = Hash_64_cstr.hash section_name in
-    let anchor_time = TimeAbsoluteNBO.of_ptime stamp_start in
+    let anchor_time = stamp_start in
     let duration_withdraw =
-      Ptime.diff stamp_start stamp_expire_withdraw
+      Timestamp.diff stamp_start stamp_expire_withdraw |> Timestamp.of_span_exn
-      |> Util.ptime_of_span_exn
-      |> TimeRelativeNBO.of_ptime
     in
     let ps = { h_denom_pub; h_section_name; anchor_time; duration_withdraw } in
     ps |> Bin.to_string bin |> denom_key_signf
@@ -41,10 +39,10 @@ let mk_future_denom denom_key_signf
     {
       section_name;
       value;
-      stamp_start= Timestamp.of_ptime stamp_start;
+      stamp_start;
-      stamp_expire_withdraw= Timestamp.of_ptime stamp_expire_withdraw;
+      stamp_expire_withdraw;
-      stamp_expire_deposit= Timestamp.of_ptime stamp_expire_deposit;
+      stamp_expire_deposit;
-      stamp_expire_legal= Timestamp.of_ptime stamp_expire_legal;
+      stamp_expire_legal;
       denom_pub;
       fee_withdraw;
       fee_deposit;
@@ -57,26 +55,17 @@ let mk_future_signkey signkey_signf
     ({ pub; priv= _; stamp_start; stamp_expire; stamp_end; master_sig= _ } :
       Signkey.t) =
   let signkey_secmod_sig =
-    let open Bin_type in
     let open Bin_signature.SigningKeyAnnouncementPS in
     let exchange_pub = pub in
-    let anchor_time = TimeAbsoluteNBO.of_ptime stamp_start in
+    let anchor_time = stamp_start in
     let duration =
-      Ptime.diff stamp_start stamp_expire
+      Timestamp.diff stamp_start stamp_expire |> Timestamp.of_span_exn
-      |> Util.ptime_of_span_exn
-      |> TimeRelativeNBO.of_ptime
     in
     let ps = { exchange_pub; anchor_time; duration } in
     ps |> Bin.to_string bin |> signkey_signf
   in
   FutureSignKey.
-    {
+    { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
-      key= pub;
-      stamp_start= Timestamp.of_ptime stamp_start;
-      stamp_expire= Timestamp.of_ptime stamp_expire;
-      stamp_end= Timestamp.of_ptime stamp_end;
-      signkey_secmod_sig;
-    }
 
 let mk_future_keys_response (secmod_signkey : Secmod_signkey.t)
     (secmod_denom : Secmod_denom.t) =

src/pg.ml

@@ -7,10 +7,8 @@ module Caqti_type = struct
      "(flags (:standard -open Prelude))" *)
   (* we want to use int64 timestamps,
      not postgresql built-in timestamp type *)
-  let ptime : Ptime.t t =
+  let ptime : Ptime.t option t = Timestamp.caqti
-    let encode i = Ok (Util.ptime_to_int64 i) in
+  let time = Timestamp.caqti
-    let decode = Util.ptime_of_int64 in
-    custom ~encode ~decode int64
 
   let amount : Amount.t t =
     let open Amount in
@@ -82,7 +80,7 @@ let preflight =
 
 let lookup_signing_key =
   let lookup_signing_key =
-    Caqti_type.(eddsa_public ->? t3 ptime ptime ptime)
+    Caqti_type.(eddsa_public ->? t3 time time time)
       "SELECT valid_from, expire_sign, expire_legal FROM exchange_sign_keys \
        WHERE exchange_pub=$1"
   in
@@ -91,7 +89,7 @@ let lookup_signing_key =
 
 let activate_signing_key =
   let insert_signkey =
-    Caqti_type.(t5 eddsa_public ptime ptime ptime eddsa_signature ->. unit)
+    Caqti_type.(t5 eddsa_public time time time eddsa_signature ->. unit)
       "INSERT INTO exchange_sign_keys (exchange_pub, valid_from, expire_sign, \
        expire_legal, master_sig) VALUES ($1, $2, $3, $4, $5)"
   in
@@ -107,8 +105,7 @@ let lookup_denomination_key =
   let lookup_denomination_key =
     Caqti_type.(
       denomination_hash
-      ->? t10 ptime ptime ptime ptime amount amount amount amount amount
+      ->? t10 time time time time amount amount amount amount amount age_mask)
-            age_mask)
       "SELECT valid_from, expire_withdraw, expire_deposit, expire_legal, coin, \
        fee_withdraw, fee_deposit, fee_refresh, fee_refund, age_mask FROM \
        denominations WHERE denom_pub_hash=$1"
@@ -119,7 +116,7 @@ let lookup_denomination_key =
 let add_denomination_key =
   let denomination_insert =
     Caqti_type.(
-      t12 denomination_hash rsa_public eddsa_signature ptime ptime ptime ptime
+      t12 denomination_hash rsa_public eddsa_signature time time time time
         amount amount amount amount (t2 amount age_mask)
       ->. unit)
       "INSERT INTO denominations (denom_pub_hash, denom_pub, master_sig, \

src/signkey.ml

@@ -5,9 +5,9 @@ open Crypto
 type t = {
   pub: EddsaPublicKey.t;
   priv: EddsaPrivateKey.t;
-  stamp_start: Ptime.t;
+  stamp_start: Timestamp.t;
-  stamp_expire: Ptime.t;
+  stamp_expire: Timestamp.t;
-  stamp_end: Ptime.t;
+  stamp_end: Timestamp.t;
   (* signature of this key by offline master key *)
   master_sig: EddsaSignature.t option;
 }
@@ -17,13 +17,13 @@ let generate () =
        - look if it exists
        - if not, create it (TOFU initialization scheme)
        - write it *)
-  (* TODO time
+  let stamp_start = Ptime_clock.now () |> Option.some in
-     correctly set those: *)
-  let stamp_start = Ptime_clock.now () in
   let stamp_expire =
-    Util.ptime_add_span_exn stamp_start Config.Exchange.signkey_legal_duration
+    Timestamp.add_span_exn stamp_start
+      (Some Config.Exchange.signkey_legal_duration)
   in
   let stamp_end = stamp_expire in
+
   let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
   let master_sig = None in
   { pub; priv; stamp_start; stamp_expire; stamp_end; master_sig }

src/timestamp.ml

@@ -0,0 +1,69 @@
+type t = Ptime.t option
+type span = Ptime.Span.t option
+
+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)
+
+(* -- *)
+
+(* 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
+
+(* TODO exn *)
+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 : Ptime.t option 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

src/timestamp.mli

@@ -0,0 +1,15 @@
+(* TODO time
+   not sure about this *)
+
+type t = Ptime.t option
+type span = Ptime.Span.t option
+
+val diff : t -> t -> span
+val add_span_exn : t -> span -> t
+val of_span_exn : span -> t
+
+(* - *)
+val jsont : t Jsont.t
+val bin : t Bin.t
+val bin_nbo : t Bin.t
+val caqti : Ptime.t option Caqti_type.t

src/util.ml

@@ -1,27 +1,3 @@
-(* -- Ptime -- *)
-
-(* TODO have a Time.t = int64
-   -> avoid having conversion everywhere
-   -> avoid using Caqti_type.ptime *)
-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.error "ptime_of_int64 error: `%Ld` is not a valid ptime" i
-  | Some ts -> Ok ts
-
-let ptime_of_span_exn span =
-  match Ptime.of_span span with
-  | None -> Fmt.failwith "Ptime.of_span: not in the range [min;max]"
-  | Some p -> p
-
-let ptime_add_span_exn p span =
-  match Ptime.add_span p span with
-  | None -> Fmt.failwith "Ptime.add_span: not in the range [min;max]"
-  | Some v -> v
-
-(* -- *** -- *)
-
 (* TODO bin
    - no [Bin.of_string] ? *)
 let bin_of_string bin s =

tools/offline.ml

@@ -49,17 +49,13 @@ let _denom_signature master_priv master_pub
   let master_sig =
     let open Bin_type in
     let open Bin_signature.DenominationKeyValidityPS in
-    (* TODO time *)
-    let of_time ts : TimeAbsoluteNBO.t =
-      TimeAbsoluteNBO.of_int64 @@ Api.Timestamp.to_int64 ts
-    in
     let denom_key_validity =
       {
         master= master_pub;
-        start= of_time stamp_start;
+        start= stamp_start;
-        expire_withdraw= of_time stamp_expire_withdraw;
+        expire_withdraw= stamp_expire_withdraw;
-        expire_spend= of_time stamp_expire_deposit;
+        expire_spend= stamp_expire_deposit;
-        expire_legal= of_time stamp_expire_legal;
+        expire_legal= stamp_expire_legal;
         value;
         fee_withdraw;
         fee_deposit;