From 19db1412c2d4259f4397b63a60b015bc007e1765 Mon Sep 17 00:00:00 2001 From: swrup Date: Fri, 28 Nov 2025 16:57:48 +0100 Subject: [PATCH] add timestamp.ml --- src/api.ml | 39 ------------------------- src/bin_type.ml | 50 +++++++++++++++----------------- src/denomination.ml | 18 ++++++------ src/management.ml | 29 ++++++------------- src/pg.ml | 15 ++++------ src/signkey.ml | 14 ++++----- src/timestamp.ml | 69 +++++++++++++++++++++++++++++++++++++++++++++ src/timestamp.mli | 15 ++++++++++ src/util.ml | 24 ---------------- tools/offline.ml | 12 +++----- 10 files changed, 143 insertions(+), 142 deletions(-) create mode 100644 src/timestamp.ml create mode 100644 src/timestamp.mli diff --git a/src/api.ml b/src/api.ml index eec54a6f..60954791 100644 --- a/src/api.ml +++ b/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 diff --git a/src/bin_type.ml b/src/bin_type.ml index 9660064f..652a0eab 100644 --- a/src/bin_type.ml +++ b/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 TimeAbsoluteNBO : Time_S = INT64_NBO -module TimeRelative : Time_S = INT64 -module TimeRelativeNBO : Time_S = INT64_NBO -module Timestamp : Time_S = INT64 -module TimestampNBO : Time_S = INT64_NBO +module TIME : Time_S = struct + type t = Timestamp.t + + let bin = Timestamp.bin +end + +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 diff --git a/src/denomination.ml b/src/denomination.ml index 65afdcc2..68aca301 100644 --- a/src/denomination.ml +++ b/src/denomination.ml @@ -4,10 +4,10 @@ type t = { pub: RsaPublicKey.t; section_name: string; value: Amount.t; - stamp_start: Ptime.t; - stamp_expire_withdraw: Ptime.t; - stamp_expire_deposit: Ptime.t; - stamp_expire_legal: Ptime.t; + stamp_start: Timestamp.t; + stamp_expire_withdraw: Timestamp.t; + stamp_expire_deposit: Timestamp.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 diff --git a/src/management.ml b/src/management.ml index 90d69bdb..b89fed1c 100644 --- a/src/management.ml +++ b/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 - |> Util.ptime_of_span_exn - |> TimeRelativeNBO.of_ptime + Timestamp.diff stamp_start stamp_expire_withdraw |> Timestamp.of_span_exn 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_expire_withdraw= Timestamp.of_ptime stamp_expire_withdraw; - stamp_expire_deposit= Timestamp.of_ptime stamp_expire_deposit; - stamp_expire_legal= Timestamp.of_ptime stamp_expire_legal; + stamp_start; + stamp_expire_withdraw; + stamp_expire_deposit; + 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 - |> Util.ptime_of_span_exn - |> TimeRelativeNBO.of_ptime + Timestamp.diff stamp_start stamp_expire |> Timestamp.of_span_exn in let ps = { exchange_pub; anchor_time; duration } in ps |> Bin.to_string bin |> signkey_signf in FutureSignKey. - { - 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; - } + { key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig } let mk_future_keys_response (secmod_signkey : Secmod_signkey.t) (secmod_denom : Secmod_denom.t) = diff --git a/src/pg.ml b/src/pg.ml index 098dfc52..cca375c5 100644 --- a/src/pg.ml +++ b/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 encode i = Ok (Util.ptime_to_int64 i) in - let decode = Util.ptime_of_int64 in - custom ~encode ~decode int64 + let ptime : Ptime.t option t = Timestamp.caqti + let time = Timestamp.caqti 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 - age_mask) + ->? t10 time time time time amount amount amount amount amount 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, \ diff --git a/src/signkey.ml b/src/signkey.ml index 2d958a33..2b29662b 100644 --- a/src/signkey.ml +++ b/src/signkey.ml @@ -5,9 +5,9 @@ open Crypto type t = { pub: EddsaPublicKey.t; priv: EddsaPrivateKey.t; - stamp_start: Ptime.t; - stamp_expire: Ptime.t; - stamp_end: Ptime.t; + stamp_start: Timestamp.t; + stamp_expire: Timestamp.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 - correctly set those: *) - let stamp_start = Ptime_clock.now () in + let stamp_start = Ptime_clock.now () |> Option.some 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 } diff --git a/src/timestamp.ml b/src/timestamp.ml new file mode 100644 index 00000000..710ac992 --- /dev/null +++ b/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 diff --git a/src/timestamp.mli b/src/timestamp.mli new file mode 100644 index 00000000..c1ac00ab --- /dev/null +++ b/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 diff --git a/src/util.ml b/src/util.ml index 9ad5f311..59ab2c3c 100644 --- a/src/util.ml +++ b/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 = diff --git a/tools/offline.ml b/tools/offline.ml index c76c3651..15a9743c 100644 --- a/tools/offline.ml +++ b/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; - expire_withdraw= of_time stamp_expire_withdraw; - expire_spend= of_time stamp_expire_deposit; - expire_legal= of_time stamp_expire_legal; + start= stamp_start; + expire_withdraw= stamp_expire_withdraw; + expire_spend= stamp_expire_deposit; + expire_legal= stamp_expire_legal; value; fee_withdraw; fee_deposit;