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

NBO bin.t only; rename time modules

Browse source
This commit is contained in:
swrup 2026-02-24 17:51:30 +01:00
parent 4f473c003a
commit 7fe11c2db3
13 changed files with 306 additions and 359 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/amount.ml
View file

@ -110,14 +110,6 @@ let make_exn value fraction currency =
| Ok v -> v
let bin =
let open Bin in
record make_exn
|+ field neint64 (fun t -> t.value)
|+ field neint32 (fun t -> t.fraction)
|+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
|> sealr
let bin_nbo =
let open Bin in
record make_exn
|+ field beint64 (fun t -> t.value)

1
src/amount.mli
View file

@ -23,5 +23,4 @@ val of_string : string -> (t, string) result
(* - *)
val jsont : t Jsont.t
val bin : t Bin.t
val bin_nbo : t Bin.t
(* [caqti] is in pg_type.ml *)

26
src/api.ml
View file

@ -11,6 +11,7 @@
let protocol_version = "31:0:0"
open Time
open Crypto
open Signatures
module DenominationHash = Hash.DenominationHash
@ -580,9 +581,9 @@ module GlobalFees = struct
history_fee: Amount.t;
account_fee: Amount.t;
purse_fee: Amount.t;
history_expiration: Time.Relative.t;
history_expiration: TimeRelative.t;
purse_account_limit: int32;
purse_timeout: Time.Relative.t;
purse_timeout: TimeRelative.t;
master_sig: GlobalFees.t;
}
@ -616,9 +617,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" Time.Relative.jsont ~enc:history_expiration
|> mem "history_expiration" TimeRelative.jsont ~enc:history_expiration
|> mem "purse_account_limit" Jsont.int32 ~enc:purse_account_limit
|> mem "purse_timeout" Time.Relative.jsont ~enc:purse_timeout
|> mem "purse_timeout" TimeRelative.jsont ~enc:purse_timeout
|> mem "master_sig" GlobalFees.jsont ~enc:master_sig
|> finish
end
@ -762,7 +763,7 @@ module ExchangePartnerSetupRequest = struct
type t = {
partner_base_url: string;
partner_pub: EddsaPublicKey.t;
wad_frequency: Time.Relative.t;
wad_frequency: TimeRelative.t;
master_sig: PartnerConfiguration.t;
start_date: Timestamp.t;
end_date: Timestamp.t;
@ -792,7 +793,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" Time.Relative.jsont ~enc:wad_frequency
|> mem "wad_frequency" TimeRelative.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
@ -807,7 +808,7 @@ module ExchangePartnerListEntry = struct
partner_base_url: string;
partner_master_pub: EddsaPublicKey.t;
wad_fee: Amount.t;
wad_frequency: Time.Relative.t;
wad_frequency: TimeRelative.t;
start_date: Timestamp.t;
end_date: Timestamp.t;
master_sig: WadPartnerSignature.t;
@ -837,7 +838,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" Time.Relative.jsont ~enc:wad_frequency
|> mem "wad_frequency" TimeRelative.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
@ -1061,7 +1062,7 @@ end
module AccountLimit = struct
type t = {
operation_type: Account_operation.t;
timeframe: Time.Relative.t;
timeframe: TimeRelative.t;
threshold: Amount.t;
soft_limit: bool option;
}
@ -1076,7 +1077,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" Time.Relative.jsont ~enc:timeframe
|> mem "timeframe" TimeRelative.jsont ~enc:timeframe
|> mem "threshold" Amount.jsont ~enc:threshold
|> opt_mem "soft_limit" Jsont.bool ~enc:soft_limit
|> finish
@ -1224,7 +1225,7 @@ module ExchangeKeysResponse = struct
kyc_enabled: bool;
disable_direct_deposit: bool;
master_public_key: EddsaPublicKey.t;
reserve_closing_delay: Time.Relative.t;
reserve_closing_delay: TimeRelative.t;
wallet_balance_limit_without_kyc: Amount.t list option;
hard_limits: AccountLimit.t list;
zero_limits: ZeroLimitedOperation.t list;
@ -1347,8 +1348,7 @@ 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" Time.Relative.jsont
~enc:reserve_closing_delay
|> mem "reserve_closing_delay" TimeRelative.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

6
src/config.ml
View file

@ -136,9 +136,9 @@ module Coin = struct
type t = {
section_name: string;
value: Amount.t;
duration_withdraw: Time.Relative.t;
duration_spend: Time.Relative.t;
duration_legal: Time.Relative.t;
duration_withdraw: Time.TimeRelative.t;
duration_spend: Time.TimeRelative.t;
duration_legal: Time.TimeRelative.t;
fee_withdraw: Amount.t;
fee_deposit: Amount.t;
fee_refresh: Amount.t;

10
src/keys.ml
View file

@ -87,11 +87,12 @@ module Make (Conn : Pg.CONN) : S = struct
l
let make_future_sk ~pub ~start ~expire =
let open Time in
let stamp_start = Timestamp.of_absolute start in
let stamp_expire = Timestamp.of_absolute expire in
let stamp_end =
Timestamp.of_absolute
@@ Time.Absolute.add start Config.Exchange.signkey_legal_duration
@@ TimeAbsolute.add start Config.Exchange.signkey_legal_duration
in
let signkey_secmod_sig =
let open Signatures.SigningKeyAnnouncement in
@ -104,6 +105,7 @@ module Make (Conn : Pg.CONN) : S = struct
{ key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
let make_future_dn ~coin ~pub ~start =
let open Time in
let Config.Coin.
{
section_name;
@ -123,13 +125,13 @@ module Make (Conn : Pg.CONN) : S = struct
in
let stamp_start = Timestamp.of_absolute start in
let stamp_expire_withdraw =
Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw
Timestamp.of_absolute @@ TimeAbsolute.add start duration_withdraw
in
let stamp_expire_deposit =
Timestamp.of_absolute @@ Time.Absolute.add start duration_spend
Timestamp.of_absolute @@ TimeAbsolute.add start duration_spend
in
let stamp_expire_legal =
Timestamp.of_absolute @@ Time.Absolute.add start duration_legal
Timestamp.of_absolute @@ TimeAbsolute.add start duration_legal
in
let open Api in
let rsa_denomination_key =

4
src/parse_config.ml
View file

@ -119,7 +119,7 @@ module Config_duration = struct
let duration = many1 duration_element <* end_of_input
(* TODO put this in Time.Relative *)
(* TODO put this in TimeRelative *)
let dunit_to_seconds u =
let rec f = function
| `Year -> 365 * f `Day
@ -136,7 +136,7 @@ module Config_duration = struct
(fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit))
0 t
|> Int64.of_int
|> Time.Relative.of_s
|> Time.TimeRelative.of_s
let parse s : duration_element list =
match parse_string ~consume:All duration s with

2
src/pg_type.ml
View file

@ -15,7 +15,7 @@ let amount : Amount.t t =
not postgresql built-in timestamp type *)
let ptime : unit t = Caqti_type.unit
let time = Timestamp.caqti
let time_span = Time.Relative.caqti
let time_span = Time.TimeRelative.caqti
let age_mask : int t = Caqti_type.int
let rsa_pub = RsaPublicKey.caqti
let eddsa_pub = EddsaPublicKey.caqti

29
src/secmod_eddsa.ml
View file

@ -11,8 +11,8 @@ module Cfg = Config.Exchange_secmod_eddsa
type key = {
priv: EddsaPrivateKey.t;
pub: EddsaPublicKey.t;
t1: Absolute.t;
t2: Absolute.t;
t1: TimeAbsolute.t;
t2: TimeAbsolute.t;
}
type t = {
@ -24,7 +24,7 @@ type t = {
let parse_filename =
let scan_filename s =
Scanf.sscanf_opt s "%Lu-%Lu" (fun t1 t2 ->
(Absolute.of_s t1, Absolute.of_s t2))
(TimeAbsolute.of_s t1, TimeAbsolute.of_s t2))
in
fun fpath -> scan_filename (Fpath.filename fpath)
@ -81,18 +81,18 @@ let gen_key t1 t2 =
(EddsaPublicKey.to_b32 pub));
{ priv; pub; t1; t2 }
let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
let sort_keys l = List.sort (fun a b -> TimeAbsolute.compare a.t2 b.t2) l
let split_in_periodes ~start ~end_ =
assert (start < end_);
(* no overlap on first periode *)
let t1 = start in
let t2 = Absolute.add start Cfg.duration in
let t2 = TimeAbsolute.add start Cfg.duration in
let acc = [ (t1, t2) ] in
let start = t2 in
let rec go acc start end_ =
let t1 = Absolute.sub start Cfg.overlap_duration in
let t2 = Absolute.add start Cfg.duration in
let t1 = TimeAbsolute.sub start Cfg.overlap_duration in
let t2 = TimeAbsolute.add start Cfg.duration in
if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
in
go acc start end_
@ -103,10 +103,10 @@ let gen_additional_keys_until_lookahead ~now l =
let start =
match List.rev (sort_keys l) with
| [] -> now
| hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
| hd :: _ -> TimeAbsolute.sub hd.t2 Cfg.overlap_duration
in
let end_ = Absolute.add now Cfg.lookahead_sign in
if Absolute.compare start end_ >= 0 then []
let end_ = TimeAbsolute.add now Cfg.lookahead_sign in
if TimeAbsolute.compare start end_ >= 0 then []
else
let periodes = split_in_periodes ~start ~end_ in
let new_keys = List.map (fun (t1, t2) -> gen_key t1 t2) periodes in
@ -159,19 +159,14 @@ let init () =
let ht = Hashtbl.create 0xff in
Ok { sm_key_priv; sm_pub; ht }
in
let now = Absolute.of_ptime (Ptime_clock.now ()) in
let now = TimeAbsolute.of_ptime (Ptime_clock.now ()) in
let keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
let new_keys = gen_additional_keys_until_lookahead ~now keys in
let () = List.iter (fun k -> Hashtbl.replace t.ht k.pub k) keys in
let+ () = list_iter write_key new_keys in
t
type info = eddsa_pub * Time.Absolute.t * Time.Absolute.t
module Make () = struct
type pub = EddsaPublicKey.t
type info = EddsaPublicKey.t * Time.Absolute.t * Time.Absolute.t
let t =
match init () with
| Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
@ -193,7 +188,7 @@ module Make () = struct
let _delete_outdated ~now =
Hashtbl.to_seq_values t.ht
|> List.of_seq
|> List.filter (fun k -> Absolute.compare now k.t2 >= 0)
|> List.filter (fun k -> TimeAbsolute.compare now k.t2 >= 0)
|> List.map (fun k -> k.pub)
|> list_iter delete

30
src/secmod_rsa.ml
View file

@ -45,8 +45,8 @@ type key = {
priv: RsaPrivateKey.t;
pub: RsaPublicKey.t;
h_pub: DenominationHash.t;
t1: Absolute.t;
t2: Absolute.t;
t1: TimeAbsolute.t;
t2: TimeAbsolute.t;
}
type t = {
@ -58,7 +58,7 @@ type t = {
let parse_filename =
let scan_filename s =
Scanf.sscanf_opt s "%Lu-%Lu" (fun t1 t2 ->
(Absolute.of_s t1, Absolute.of_s t2))
(TimeAbsolute.of_s t1, TimeAbsolute.of_s t2))
in
fun fpath -> scan_filename (Fpath.filename fpath)
@ -125,18 +125,18 @@ let gen_key ~section_name t1 t2 =
(DenominationHash.to_octets h_pub |> B32.encode));
{ section_name; priv; pub; h_pub; t1; t2 }
let sort_keys l = List.sort (fun a b -> Absolute.compare a.t2 b.t2) l
let sort_keys l = List.sort (fun a b -> TimeAbsolute.compare a.t2 b.t2) l
let split_in_periodes ~start ~end_ ~duration_withdraw =
assert (start < end_);
(* no overlap on first periode *)
let t1 = start in
let t2 = Absolute.add start duration_withdraw in
let t2 = TimeAbsolute.add start duration_withdraw in
let acc = [ (t1, t2) ] in
let start = t2 in
let rec go acc start end_ =
let t1 = Absolute.sub start Cfg.overlap_duration in
let t2 = Absolute.add start duration_withdraw in
let t1 = TimeAbsolute.sub start Cfg.overlap_duration in
let t2 = TimeAbsolute.add start duration_withdraw in
if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
in
go acc start end_
@ -147,10 +147,10 @@ let gen_additional_keys_until_lookahead ~now ~section_name l =
let start =
match List.rev (sort_keys l) with
| [] -> now
| hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
| hd :: _ -> TimeAbsolute.sub hd.t2 Cfg.overlap_duration
in
let end_ = Absolute.add now Cfg.lookahead_sign in
if Absolute.compare start end_ >= 0 then []
let end_ = TimeAbsolute.add now Cfg.lookahead_sign in
if TimeAbsolute.compare start end_ >= 0 then []
else
let duration_withdraw = Cfg.duration_withdraw ~section_name in
let periodes = split_in_periodes ~start ~end_ ~duration_withdraw in
@ -212,7 +212,7 @@ let init () =
let ht = Hashtbl.create 0xff in
Ok { sm_key_priv; sm_pub; ht }
in
let now = Absolute.of_ptime (Ptime_clock.now ()) in
let now = TimeAbsolute.of_ptime (Ptime_clock.now ()) in
let all_keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
let new_keys_l =
List.map
@ -228,13 +228,7 @@ let init () =
let+ () = list_iter write_key new_keys in
t
type info = string * rsa_pub * Time.Absolute.t * Time.Absolute.t
module Make () = struct
type pub = RsaPublicKey.t
type info = string * RsaPublicKey.t * Time.Absolute.t * Time.Absolute.t
(* --- *)
let t =
match init () with
| Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e
@ -251,7 +245,7 @@ module Make () = struct
let _delete_outdated ~now =
Hashtbl.to_seq t.ht
|> List.of_seq
|> List.filter (fun (_h_pub, k) -> Absolute.compare now k.t2 >= 0)
|> List.filter (fun (_h_pub, k) -> TimeAbsolute.compare now k.t2 >= 0)
|> List.map (fun (h_pub, _k) -> h_pub)
|> list_iter delete

510
src/signatures.ml
View file

File diff suppressed because it is too large Load diff

12
src/time.ml
View file

@ -1,6 +1,6 @@
let uint64_max = Int64.minus_one
module Relative = struct
module TimeRelative = struct
type t = Int64.t
let forever = uint64_max
@ -26,8 +26,7 @@ module Relative = struct
let v = Int64.mul s 1_000_000L in
if Int64.unsigned_div v 1_000_000L <> s then forever else v
let bin = Bin.neint64
let bin_nbo = Bin.beint64
let bin = Bin.beint64
let caqti =
let encode v = Ok v in
@ -57,7 +56,7 @@ module Relative = struct
|> Jsont.Object.finish
end
module Absolute = struct
module TimeAbsolute = struct
type t = Int64.t
let never = uint64_max
@ -117,9 +116,8 @@ module Timestamp = struct
let of_absolute a =
if a = never then never else Int64.sub a (Int64.unsigned_rem a 1_000_000L)
let of_ptime v = v |> Absolute.of_ptime |> of_absolute
let bin = Bin.neint64
let bin_nbo = Bin.beint64
let of_ptime v = v |> TimeAbsolute.of_ptime |> of_absolute
let bin = Bin.beint64
let caqti =
let encode v = Ok v in

16
src/time.mli
View file

@ -1,4 +1,4 @@
module Relative : sig
module TimeRelative : sig
type t
val forever : t
@ -12,12 +12,11 @@ module Relative : sig
(* - *)
val bin : t Bin.t
val bin_nbo : t Bin.t
val caqti : t Caqti_type.t
val jsont : t Jsont.t
end
module Absolute : sig
module TimeAbsolute : sig
type t
val never : t
@ -25,9 +24,9 @@ module Absolute : sig
val compare : t -> t -> int
val min : t -> t -> t
val max : t -> t -> t
val diff : t -> t -> Relative.t
val add : t -> Relative.t -> t
val sub : t -> Relative.t -> t
val diff : t -> t -> TimeRelative.t
val add : t -> TimeRelative.t -> t
val sub : t -> TimeRelative.t -> t
val of_s : int64 -> t
val of_ptime : Ptime.t -> t
end
@ -40,18 +39,17 @@ module Timestamp : sig
val compare : t -> t -> int
val min : t -> t -> t
val max : t -> t -> t
val diff : t -> t -> Relative.t
val diff : t -> t -> TimeRelative.t
val of_s : int64 -> t
(* none if t = never *)
val to_s : t -> int64 option
val of_absolute : Absolute.t -> t
val of_absolute : TimeAbsolute.t -> t
val of_ptime : Ptime.t -> t
(* TODO add pp *)
(* - *)
val bin : t Bin.t
val bin_nbo : t Bin.t
val caqti : t Caqti_type.t
val jsont : t Jsont.t
end

11
tools/offline.ml
View file

@ -14,16 +14,17 @@ open Offline_impl
module Arg = struct
include Arg
open Time
(* in seconds *)
let timestamp =
let parser s =
match int_of_string_opt s with
| None -> Error "not an int"
| Some n -> Ok (Time.Timestamp.of_s (Int64.of_int n))
| Some n -> Ok (Timestamp.of_s (Int64.of_int n))
in
let pp fmt t =
match Time.Timestamp.to_s t with
match Timestamp.to_s t with
| None -> Fmt.pf fmt "never"
| Some s -> Fmt.pf fmt "%Ld" s
in
@ -34,11 +35,11 @@ module Arg = struct
let parser s =
match int_of_string_opt s with
| None -> Error "not an int"
| Some s -> Ok (Time.Relative.of_s (Int64.of_int s))
| Some s -> Ok (TimeRelative.of_s (Int64.of_int s))
in
let pp fmt d =
let t = Time.Timestamp.of_absolute Time.Absolute.(add zero d) in
match Time.Timestamp.to_s t with
let t = Timestamp.of_absolute TimeAbsolute.(add zero d) in
match Timestamp.to_s t with
| None -> Fmt.pf fmt "never"
| Some s -> Fmt.pf fmt "%Ld" s
in