diff --git a/src/bin_type.ml b/src/bin_type.ml index 7370141a..ca218caf 100644 --- a/src/bin_type.ml +++ b/src/bin_type.ml @@ -58,28 +58,29 @@ module Bytes_64 = struct end (* -- Time -- *) -module type Time_S = sig - type t = Timestamp.t - - val bin : t Bin.t -end - -module TIME : Time_S = struct +module TimeAbsolute = 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 TimeAbsoluteNBO : Time_S = TIME_NBO -module TimeRelative : Time_S = TIME -module TimeRelativeNBO : Time_S = TIME_NBO +module TimeRelative = struct + type t = Timestamp.span + + let bin = Timestamp.Span.bin +end + +module TimeRelativeNBO = struct + type t = Timestamp.span + + let bin = Timestamp.Span.bin_nbo +end (* -- Cryptographic primitives -- *) diff --git a/src/timestamp.ml b/src/timestamp.ml index bb061c90..e2980527 100644 --- a/src/timestamp.ml +++ b/src/timestamp.ml @@ -1,27 +1,52 @@ -type t = Ptime.t option -type span = Ptime.Span.t option +type t = int64 +type span = t -let now () = Ptime_clock.now () |> Option.some +let us_count_in_day = 86_400_000_000_L +let ps_count_in_us = 1_000_000_L +let ps_count_in_day = 86_400_000_000_000_000_L + +module Span = struct + type t = span + + let of_int64_us us = + let n = Int64.abs us in + let d = Int64.to_int @@ Int64.div n us_count_in_day in + let ps = Int64.(mul (rem n us_count_in_day) ps_count_in_us) in + let span = Ptime.Span.v (d, ps) in + if us < 0_L then Ptime.Span.neg span else span + + let to_int64_us span = + let d, ps = Ptime.Span.to_d_ps span in + Int64.add + (Int64.mul (Int64.of_int d) us_count_in_day) + (Int64.div ps ps_count_in_us) +end + +let of_int64_us us = + let span = Span.of_int64_us us in + Ptime.of_span span + +let to_int64_us t = + let span = Ptime.to_span t in + Span.to_int64_us span + +(* --- *) + +let ptime_to_int64 ptime = ptime |> Ptime.to_float_s |> Int64.of_float +let epoch = ptime_to_int64 Ptime.epoch +let now () = Ptime_clock.now () |> ptime_to_int64 |> Option.some let diff a b = match (a, b) with | None, _ | _, None -> None - | Some a, Some b -> Some (Ptime.diff a b) + | Some a, Some b -> Some (Int64.sub a b) -let add_span_exn t span = +let add_span 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) + | Some t, Some span -> Some (Int64.add t span) -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) +let of_span = function None -> None | Some span -> Some (Int64.add epoch span) (* -- *) @@ -50,9 +75,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 = match Ptime.of_float_s (Int64.to_float i) with | None -> Fmt.failwith "ptime_of_int64 error: `%Ld` is not a valid ptime" i diff --git a/src/timestamp.mli b/src/timestamp.mli index 4da82338..073df447 100644 --- a/src/timestamp.mli +++ b/src/timestamp.mli @@ -1,14 +1,13 @@ (* TODO time uhuh! need to be int64 for binary/pg round trip *) - type t type span val now : unit -> t val diff : t -> t -> span -val add_span_exn : t -> span -> t -val of_span_exn : span -> t +val add_span : t -> span -> t +val of_span : span -> t val of_int64 : int64 -> t val to_int64 : t -> int64 val span_of_int64 : int64 -> span