swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

better relative time

Browse source
This commit is contained in:
swrup 2025-12-11 07:23:51 +01:00
parent 0e46ea162a
commit 262aeaec66
8 changed files with 115 additions and 89 deletions
Download patch file Download diff file Expand all files Collapse all files

55
src/api.ml
View file

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

8
src/bin_sig.ml
View file

@ -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
type t = Timestamp.t
let bin = Timestamp.bin_nbo
end
module TimestampNBO = TimeAbsoluteNBO
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)

25
src/bin_type.ml
View file

@ -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.t
let bin = Timestamp.Span.bin
end
module TimeRelativeNBO = struct
type t = Timestamp.Span.t
let bin = Timestamp.Span.bin_nbo
end
(* -- Cryptographic primitives -- *)

22
src/management.ml
View file

@ -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 =
Timestamp.diff stamp_start stamp_expire_withdraw |> Timestamp.of_span_exn
in
let duration_withdraw = Timestamp.diff stamp_start stamp_expire_withdraw 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 =
Timestamp.diff stamp_start stamp_expire |> Timestamp.of_span_exn
in
let duration = Timestamp.diff stamp_start stamp_expire 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..... *)
let dummy_relative_time = None in
(* TODO what is kyc_timeout, kyc_fee ? *)
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 = dummy_relative_time in
let kyc_timeout = None 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;

15
src/pg.ml
View file

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

60
src/timestamp.ml
View file

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

11
src/timestamp.mli
View file

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

8
tools/offline_sig.ml
View file

@ -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 =
Timestamp.diff stamp_start stamp_expire |> Timestamp.of_span_exn
in
let duration = Timestamp.diff stamp_start stamp_expire 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 =
Timestamp.diff stamp_start stamp_expire_withdraw |> Timestamp.of_span_exn
in
let duration_withdraw = Timestamp.diff stamp_start stamp_expire_withdraw 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 }