NBO bin.t only; rename time modules
This commit is contained in:
parent
4f473c003a
commit
7fe11c2db3
13 changed files with 306 additions and 359 deletions
|
|
@ -110,14 +110,6 @@ let make_exn value fraction currency =
|
||||||
| Ok v -> v
|
| Ok v -> v
|
||||||
|
|
||||||
let bin =
|
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
|
let open Bin in
|
||||||
record make_exn
|
record make_exn
|
||||||
|+ field beint64 (fun t -> t.value)
|
|+ field beint64 (fun t -> t.value)
|
||||||
|
|
|
||||||
|
|
@ -23,5 +23,4 @@ val of_string : string -> (t, string) result
|
||||||
(* - *)
|
(* - *)
|
||||||
val jsont : t Jsont.t
|
val jsont : t Jsont.t
|
||||||
val bin : t Bin.t
|
val bin : t Bin.t
|
||||||
val bin_nbo : t Bin.t
|
|
||||||
(* [caqti] is in pg_type.ml *)
|
(* [caqti] is in pg_type.ml *)
|
||||||
|
|
|
||||||
26
src/api.ml
26
src/api.ml
|
|
@ -11,6 +11,7 @@
|
||||||
|
|
||||||
let protocol_version = "31:0:0"
|
let protocol_version = "31:0:0"
|
||||||
|
|
||||||
|
open Time
|
||||||
open Crypto
|
open Crypto
|
||||||
open Signatures
|
open Signatures
|
||||||
module DenominationHash = Hash.DenominationHash
|
module DenominationHash = Hash.DenominationHash
|
||||||
|
|
@ -580,9 +581,9 @@ module GlobalFees = struct
|
||||||
history_fee: Amount.t;
|
history_fee: Amount.t;
|
||||||
account_fee: Amount.t;
|
account_fee: Amount.t;
|
||||||
purse_fee: Amount.t;
|
purse_fee: Amount.t;
|
||||||
history_expiration: Time.Relative.t;
|
history_expiration: TimeRelative.t;
|
||||||
purse_account_limit: int32;
|
purse_account_limit: int32;
|
||||||
purse_timeout: Time.Relative.t;
|
purse_timeout: TimeRelative.t;
|
||||||
master_sig: GlobalFees.t;
|
master_sig: GlobalFees.t;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -616,9 +617,9 @@ module GlobalFees = struct
|
||||||
|> mem "history_fee" Amount.jsont ~enc:history_fee
|
|> mem "history_fee" Amount.jsont ~enc:history_fee
|
||||||
|> mem "account_fee" Amount.jsont ~enc:account_fee
|
|> mem "account_fee" Amount.jsont ~enc:account_fee
|
||||||
|> mem "purse_fee" Amount.jsont ~enc:purse_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_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
|
|> mem "master_sig" GlobalFees.jsont ~enc:master_sig
|
||||||
|> finish
|
|> finish
|
||||||
end
|
end
|
||||||
|
|
@ -762,7 +763,7 @@ module ExchangePartnerSetupRequest = struct
|
||||||
type t = {
|
type t = {
|
||||||
partner_base_url: string;
|
partner_base_url: string;
|
||||||
partner_pub: EddsaPublicKey.t;
|
partner_pub: EddsaPublicKey.t;
|
||||||
wad_frequency: Time.Relative.t;
|
wad_frequency: TimeRelative.t;
|
||||||
master_sig: PartnerConfiguration.t;
|
master_sig: PartnerConfiguration.t;
|
||||||
start_date: Timestamp.t;
|
start_date: Timestamp.t;
|
||||||
end_date: Timestamp.t;
|
end_date: Timestamp.t;
|
||||||
|
|
@ -792,7 +793,7 @@ module ExchangePartnerSetupRequest = struct
|
||||||
map ~kind:"ExchangePartnerSetupRequest" make
|
map ~kind:"ExchangePartnerSetupRequest" make
|
||||||
|> mem "partner_base_url" Jsont.string ~enc:partner_base_url
|
|> mem "partner_base_url" Jsont.string ~enc:partner_base_url
|
||||||
|> mem "partner_pub" EddsaPublicKey.jsont ~enc:partner_pub
|
|> 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 "master_sig" PartnerConfiguration.jsont ~enc:master_sig
|
||||||
|> mem "start_date" Timestamp.jsont ~enc:start_date
|
|> mem "start_date" Timestamp.jsont ~enc:start_date
|
||||||
|> mem "end_date" Timestamp.jsont ~enc:end_date
|
|> mem "end_date" Timestamp.jsont ~enc:end_date
|
||||||
|
|
@ -807,7 +808,7 @@ module ExchangePartnerListEntry = struct
|
||||||
partner_base_url: string;
|
partner_base_url: string;
|
||||||
partner_master_pub: EddsaPublicKey.t;
|
partner_master_pub: EddsaPublicKey.t;
|
||||||
wad_fee: Amount.t;
|
wad_fee: Amount.t;
|
||||||
wad_frequency: Time.Relative.t;
|
wad_frequency: TimeRelative.t;
|
||||||
start_date: Timestamp.t;
|
start_date: Timestamp.t;
|
||||||
end_date: Timestamp.t;
|
end_date: Timestamp.t;
|
||||||
master_sig: WadPartnerSignature.t;
|
master_sig: WadPartnerSignature.t;
|
||||||
|
|
@ -837,7 +838,7 @@ module ExchangePartnerListEntry = struct
|
||||||
|> mem "partner_base_url" Jsont.string ~enc:partner_base_url
|
|> mem "partner_base_url" Jsont.string ~enc:partner_base_url
|
||||||
|> mem "partner_master_pub" EddsaPublicKey.jsont ~enc:partner_master_pub
|
|> mem "partner_master_pub" EddsaPublicKey.jsont ~enc:partner_master_pub
|
||||||
|> mem "wad_fee" Amount.jsont ~enc:wad_fee
|
|> 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 "start_date" Timestamp.jsont ~enc:start_date
|
||||||
|> mem "end_date" Timestamp.jsont ~enc:end_date
|
|> mem "end_date" Timestamp.jsont ~enc:end_date
|
||||||
|> mem "master_sig" WadPartnerSignature.jsont ~enc:master_sig
|
|> mem "master_sig" WadPartnerSignature.jsont ~enc:master_sig
|
||||||
|
|
@ -1061,7 +1062,7 @@ end
|
||||||
module AccountLimit = struct
|
module AccountLimit = struct
|
||||||
type t = {
|
type t = {
|
||||||
operation_type: Account_operation.t;
|
operation_type: Account_operation.t;
|
||||||
timeframe: Time.Relative.t;
|
timeframe: TimeRelative.t;
|
||||||
threshold: Amount.t;
|
threshold: Amount.t;
|
||||||
soft_limit: bool option;
|
soft_limit: bool option;
|
||||||
}
|
}
|
||||||
|
|
@ -1076,7 +1077,7 @@ module AccountLimit = struct
|
||||||
let soft_limit v = v.soft_limit in
|
let soft_limit v = v.soft_limit in
|
||||||
map ~kind:"AccountLimit" make
|
map ~kind:"AccountLimit" make
|
||||||
|> mem "operation_type" Account_operation.jsont ~enc:operation_type
|
|> 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
|
|> mem "threshold" Amount.jsont ~enc:threshold
|
||||||
|> opt_mem "soft_limit" Jsont.bool ~enc:soft_limit
|
|> opt_mem "soft_limit" Jsont.bool ~enc:soft_limit
|
||||||
|> finish
|
|> finish
|
||||||
|
|
@ -1224,7 +1225,7 @@ module ExchangeKeysResponse = struct
|
||||||
kyc_enabled: bool;
|
kyc_enabled: bool;
|
||||||
disable_direct_deposit: bool;
|
disable_direct_deposit: bool;
|
||||||
master_public_key: EddsaPublicKey.t;
|
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;
|
wallet_balance_limit_without_kyc: Amount.t list option;
|
||||||
hard_limits: AccountLimit.t list;
|
hard_limits: AccountLimit.t list;
|
||||||
zero_limits: ZeroLimitedOperation.t list;
|
zero_limits: ZeroLimitedOperation.t list;
|
||||||
|
|
@ -1347,8 +1348,7 @@ module ExchangeKeysResponse = struct
|
||||||
|> mem "kyc_enabled" Jsont.bool ~enc:kyc_enabled
|
|> mem "kyc_enabled" Jsont.bool ~enc:kyc_enabled
|
||||||
|> mem "disable_direct_deposit" Jsont.bool ~enc:disable_direct_deposit
|
|> mem "disable_direct_deposit" Jsont.bool ~enc:disable_direct_deposit
|
||||||
|> mem "master_public_key" EddsaPublicKey.jsont ~enc:master_public_key
|
|> mem "master_public_key" EddsaPublicKey.jsont ~enc:master_public_key
|
||||||
|> mem "reserve_closing_delay" Time.Relative.jsont
|
|> mem "reserve_closing_delay" TimeRelative.jsont ~enc:reserve_closing_delay
|
||||||
~enc:reserve_closing_delay
|
|
||||||
|> opt_mem "wallet_balance_limit_without_kyc" (Jsont.list Amount.jsont)
|
|> opt_mem "wallet_balance_limit_without_kyc" (Jsont.list Amount.jsont)
|
||||||
~enc:wallet_balance_limit_without_kyc
|
~enc:wallet_balance_limit_without_kyc
|
||||||
|> mem "hard_limits" (Jsont.list AccountLimit.jsont) ~enc:hard_limits
|
|> mem "hard_limits" (Jsont.list AccountLimit.jsont) ~enc:hard_limits
|
||||||
|
|
|
||||||
|
|
@ -136,9 +136,9 @@ module Coin = struct
|
||||||
type t = {
|
type t = {
|
||||||
section_name: string;
|
section_name: string;
|
||||||
value: Amount.t;
|
value: Amount.t;
|
||||||
duration_withdraw: Time.Relative.t;
|
duration_withdraw: Time.TimeRelative.t;
|
||||||
duration_spend: Time.Relative.t;
|
duration_spend: Time.TimeRelative.t;
|
||||||
duration_legal: Time.Relative.t;
|
duration_legal: Time.TimeRelative.t;
|
||||||
fee_withdraw: Amount.t;
|
fee_withdraw: Amount.t;
|
||||||
fee_deposit: Amount.t;
|
fee_deposit: Amount.t;
|
||||||
fee_refresh: Amount.t;
|
fee_refresh: Amount.t;
|
||||||
|
|
|
||||||
10
src/keys.ml
10
src/keys.ml
|
|
@ -87,11 +87,12 @@ module Make (Conn : Pg.CONN) : S = struct
|
||||||
l
|
l
|
||||||
|
|
||||||
let make_future_sk ~pub ~start ~expire =
|
let make_future_sk ~pub ~start ~expire =
|
||||||
|
let open Time in
|
||||||
let stamp_start = Timestamp.of_absolute start in
|
let stamp_start = Timestamp.of_absolute start in
|
||||||
let stamp_expire = Timestamp.of_absolute expire in
|
let stamp_expire = Timestamp.of_absolute expire in
|
||||||
let stamp_end =
|
let stamp_end =
|
||||||
Timestamp.of_absolute
|
Timestamp.of_absolute
|
||||||
@@ Time.Absolute.add start Config.Exchange.signkey_legal_duration
|
@@ TimeAbsolute.add start Config.Exchange.signkey_legal_duration
|
||||||
in
|
in
|
||||||
let signkey_secmod_sig =
|
let signkey_secmod_sig =
|
||||||
let open Signatures.SigningKeyAnnouncement in
|
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 }
|
{ key= pub; stamp_start; stamp_expire; stamp_end; signkey_secmod_sig }
|
||||||
|
|
||||||
let make_future_dn ~coin ~pub ~start =
|
let make_future_dn ~coin ~pub ~start =
|
||||||
|
let open Time in
|
||||||
let Config.Coin.
|
let Config.Coin.
|
||||||
{
|
{
|
||||||
section_name;
|
section_name;
|
||||||
|
|
@ -123,13 +125,13 @@ module Make (Conn : Pg.CONN) : S = struct
|
||||||
in
|
in
|
||||||
let stamp_start = Timestamp.of_absolute start in
|
let stamp_start = Timestamp.of_absolute start in
|
||||||
let stamp_expire_withdraw =
|
let stamp_expire_withdraw =
|
||||||
Timestamp.of_absolute @@ Time.Absolute.add start duration_withdraw
|
Timestamp.of_absolute @@ TimeAbsolute.add start duration_withdraw
|
||||||
in
|
in
|
||||||
let stamp_expire_deposit =
|
let stamp_expire_deposit =
|
||||||
Timestamp.of_absolute @@ Time.Absolute.add start duration_spend
|
Timestamp.of_absolute @@ TimeAbsolute.add start duration_spend
|
||||||
in
|
in
|
||||||
let stamp_expire_legal =
|
let stamp_expire_legal =
|
||||||
Timestamp.of_absolute @@ Time.Absolute.add start duration_legal
|
Timestamp.of_absolute @@ TimeAbsolute.add start duration_legal
|
||||||
in
|
in
|
||||||
let open Api in
|
let open Api in
|
||||||
let rsa_denomination_key =
|
let rsa_denomination_key =
|
||||||
|
|
|
||||||
|
|
@ -119,7 +119,7 @@ module Config_duration = struct
|
||||||
|
|
||||||
let duration = many1 duration_element <* end_of_input
|
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 dunit_to_seconds u =
|
||||||
let rec f = function
|
let rec f = function
|
||||||
| `Year -> 365 * f `Day
|
| `Year -> 365 * f `Day
|
||||||
|
|
@ -136,7 +136,7 @@ module Config_duration = struct
|
||||||
(fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit))
|
(fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit))
|
||||||
0 t
|
0 t
|
||||||
|> Int64.of_int
|
|> Int64.of_int
|
||||||
|> Time.Relative.of_s
|
|> Time.TimeRelative.of_s
|
||||||
|
|
||||||
let parse s : duration_element list =
|
let parse s : duration_element list =
|
||||||
match parse_string ~consume:All duration s with
|
match parse_string ~consume:All duration s with
|
||||||
|
|
|
||||||
|
|
@ -15,7 +15,7 @@ let amount : Amount.t t =
|
||||||
not postgresql built-in timestamp type *)
|
not postgresql built-in timestamp type *)
|
||||||
let ptime : unit t = Caqti_type.unit
|
let ptime : unit t = Caqti_type.unit
|
||||||
let time = Timestamp.caqti
|
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 age_mask : int t = Caqti_type.int
|
||||||
let rsa_pub = RsaPublicKey.caqti
|
let rsa_pub = RsaPublicKey.caqti
|
||||||
let eddsa_pub = EddsaPublicKey.caqti
|
let eddsa_pub = EddsaPublicKey.caqti
|
||||||
|
|
|
||||||
|
|
@ -11,8 +11,8 @@ module Cfg = Config.Exchange_secmod_eddsa
|
||||||
type key = {
|
type key = {
|
||||||
priv: EddsaPrivateKey.t;
|
priv: EddsaPrivateKey.t;
|
||||||
pub: EddsaPublicKey.t;
|
pub: EddsaPublicKey.t;
|
||||||
t1: Absolute.t;
|
t1: TimeAbsolute.t;
|
||||||
t2: Absolute.t;
|
t2: TimeAbsolute.t;
|
||||||
}
|
}
|
||||||
|
|
||||||
type t = {
|
type t = {
|
||||||
|
|
@ -24,7 +24,7 @@ type t = {
|
||||||
let parse_filename =
|
let parse_filename =
|
||||||
let scan_filename s =
|
let scan_filename s =
|
||||||
Scanf.sscanf_opt s "%Lu-%Lu" (fun t1 t2 ->
|
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
|
in
|
||||||
fun fpath -> scan_filename (Fpath.filename fpath)
|
fun fpath -> scan_filename (Fpath.filename fpath)
|
||||||
|
|
||||||
|
|
@ -81,18 +81,18 @@ let gen_key t1 t2 =
|
||||||
(EddsaPublicKey.to_b32 pub));
|
(EddsaPublicKey.to_b32 pub));
|
||||||
{ priv; pub; t1; t2 }
|
{ 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_ =
|
let split_in_periodes ~start ~end_ =
|
||||||
assert (start < end_);
|
assert (start < end_);
|
||||||
(* no overlap on first periode *)
|
(* no overlap on first periode *)
|
||||||
let t1 = start in
|
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 acc = [ (t1, t2) ] in
|
||||||
let start = t2 in
|
let start = t2 in
|
||||||
let rec go acc start end_ =
|
let rec go acc start end_ =
|
||||||
let t1 = Absolute.sub start Cfg.overlap_duration in
|
let t1 = TimeAbsolute.sub start Cfg.overlap_duration in
|
||||||
let t2 = Absolute.add start Cfg.duration in
|
let t2 = TimeAbsolute.add start Cfg.duration in
|
||||||
if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
|
if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
|
||||||
in
|
in
|
||||||
go acc start end_
|
go acc start end_
|
||||||
|
|
@ -103,10 +103,10 @@ let gen_additional_keys_until_lookahead ~now l =
|
||||||
let start =
|
let start =
|
||||||
match List.rev (sort_keys l) with
|
match List.rev (sort_keys l) with
|
||||||
| [] -> now
|
| [] -> now
|
||||||
| hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
|
| hd :: _ -> TimeAbsolute.sub hd.t2 Cfg.overlap_duration
|
||||||
in
|
in
|
||||||
let end_ = Absolute.add now Cfg.lookahead_sign in
|
let end_ = TimeAbsolute.add now Cfg.lookahead_sign in
|
||||||
if Absolute.compare start end_ >= 0 then []
|
if TimeAbsolute.compare start end_ >= 0 then []
|
||||||
else
|
else
|
||||||
let periodes = split_in_periodes ~start ~end_ in
|
let periodes = split_in_periodes ~start ~end_ in
|
||||||
let new_keys = List.map (fun (t1, t2) -> gen_key t1 t2) periodes 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
|
let ht = Hashtbl.create 0xff in
|
||||||
Ok { sm_key_priv; sm_pub; ht }
|
Ok { sm_key_priv; sm_pub; ht }
|
||||||
in
|
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 keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
|
||||||
let new_keys = gen_additional_keys_until_lookahead ~now keys 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 (fun k -> Hashtbl.replace t.ht k.pub k) keys in
|
||||||
let+ () = list_iter write_key new_keys in
|
let+ () = list_iter write_key new_keys in
|
||||||
t
|
t
|
||||||
|
|
||||||
type info = eddsa_pub * Time.Absolute.t * Time.Absolute.t
|
|
||||||
|
|
||||||
module Make () = struct
|
module Make () = struct
|
||||||
type pub = EddsaPublicKey.t
|
|
||||||
type info = EddsaPublicKey.t * Time.Absolute.t * Time.Absolute.t
|
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
match init () with
|
match init () with
|
||||||
| Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
|
| Error e -> Fmt.failwith "secmod_eddsa initialization failure: %s." e
|
||||||
|
|
@ -193,7 +188,7 @@ module Make () = struct
|
||||||
let _delete_outdated ~now =
|
let _delete_outdated ~now =
|
||||||
Hashtbl.to_seq_values t.ht
|
Hashtbl.to_seq_values t.ht
|
||||||
|> List.of_seq
|
|> 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.map (fun k -> k.pub)
|
||||||
|> list_iter delete
|
|> list_iter delete
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -45,8 +45,8 @@ type key = {
|
||||||
priv: RsaPrivateKey.t;
|
priv: RsaPrivateKey.t;
|
||||||
pub: RsaPublicKey.t;
|
pub: RsaPublicKey.t;
|
||||||
h_pub: DenominationHash.t;
|
h_pub: DenominationHash.t;
|
||||||
t1: Absolute.t;
|
t1: TimeAbsolute.t;
|
||||||
t2: Absolute.t;
|
t2: TimeAbsolute.t;
|
||||||
}
|
}
|
||||||
|
|
||||||
type t = {
|
type t = {
|
||||||
|
|
@ -58,7 +58,7 @@ type t = {
|
||||||
let parse_filename =
|
let parse_filename =
|
||||||
let scan_filename s =
|
let scan_filename s =
|
||||||
Scanf.sscanf_opt s "%Lu-%Lu" (fun t1 t2 ->
|
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
|
in
|
||||||
fun fpath -> scan_filename (Fpath.filename fpath)
|
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));
|
(DenominationHash.to_octets h_pub |> B32.encode));
|
||||||
{ section_name; priv; pub; h_pub; t1; t2 }
|
{ 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 =
|
let split_in_periodes ~start ~end_ ~duration_withdraw =
|
||||||
assert (start < end_);
|
assert (start < end_);
|
||||||
(* no overlap on first periode *)
|
(* no overlap on first periode *)
|
||||||
let t1 = start in
|
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 acc = [ (t1, t2) ] in
|
||||||
let start = t2 in
|
let start = t2 in
|
||||||
let rec go acc start end_ =
|
let rec go acc start end_ =
|
||||||
let t1 = Absolute.sub start Cfg.overlap_duration in
|
let t1 = TimeAbsolute.sub start Cfg.overlap_duration in
|
||||||
let t2 = Absolute.add start duration_withdraw in
|
let t2 = TimeAbsolute.add start duration_withdraw in
|
||||||
if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
|
if t2 > end_ then acc else go ((t1, t2) :: acc) t2 end_
|
||||||
in
|
in
|
||||||
go acc start end_
|
go acc start end_
|
||||||
|
|
@ -147,10 +147,10 @@ let gen_additional_keys_until_lookahead ~now ~section_name l =
|
||||||
let start =
|
let start =
|
||||||
match List.rev (sort_keys l) with
|
match List.rev (sort_keys l) with
|
||||||
| [] -> now
|
| [] -> now
|
||||||
| hd :: _ -> Absolute.sub hd.t2 Cfg.overlap_duration
|
| hd :: _ -> TimeAbsolute.sub hd.t2 Cfg.overlap_duration
|
||||||
in
|
in
|
||||||
let end_ = Absolute.add now Cfg.lookahead_sign in
|
let end_ = TimeAbsolute.add now Cfg.lookahead_sign in
|
||||||
if Absolute.compare start end_ >= 0 then []
|
if TimeAbsolute.compare start end_ >= 0 then []
|
||||||
else
|
else
|
||||||
let duration_withdraw = Cfg.duration_withdraw ~section_name in
|
let duration_withdraw = Cfg.duration_withdraw ~section_name in
|
||||||
let periodes = split_in_periodes ~start ~end_ ~duration_withdraw in
|
let periodes = split_in_periodes ~start ~end_ ~duration_withdraw in
|
||||||
|
|
@ -212,7 +212,7 @@ let init () =
|
||||||
let ht = Hashtbl.create 0xff in
|
let ht = Hashtbl.create 0xff in
|
||||||
Ok { sm_key_priv; sm_pub; ht }
|
Ok { sm_key_priv; sm_pub; ht }
|
||||||
in
|
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 all_keys = List.of_seq @@ Hashtbl.to_seq_values t.ht in
|
||||||
let new_keys_l =
|
let new_keys_l =
|
||||||
List.map
|
List.map
|
||||||
|
|
@ -228,13 +228,7 @@ let init () =
|
||||||
let+ () = list_iter write_key new_keys in
|
let+ () = list_iter write_key new_keys in
|
||||||
t
|
t
|
||||||
|
|
||||||
type info = string * rsa_pub * Time.Absolute.t * Time.Absolute.t
|
|
||||||
|
|
||||||
module Make () = struct
|
module Make () = struct
|
||||||
type pub = RsaPublicKey.t
|
|
||||||
type info = string * RsaPublicKey.t * Time.Absolute.t * Time.Absolute.t
|
|
||||||
|
|
||||||
(* --- *)
|
|
||||||
let t =
|
let t =
|
||||||
match init () with
|
match init () with
|
||||||
| Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e
|
| Error e -> Fmt.failwith "secmod_rsa initialization failure: %s." e
|
||||||
|
|
@ -251,7 +245,7 @@ module Make () = struct
|
||||||
let _delete_outdated ~now =
|
let _delete_outdated ~now =
|
||||||
Hashtbl.to_seq t.ht
|
Hashtbl.to_seq t.ht
|
||||||
|> List.of_seq
|
|> 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.map (fun (h_pub, _k) -> h_pub)
|
||||||
|> list_iter delete
|
|> list_iter delete
|
||||||
|
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load diff
12
src/time.ml
12
src/time.ml
|
|
@ -1,6 +1,6 @@
|
||||||
let uint64_max = Int64.minus_one
|
let uint64_max = Int64.minus_one
|
||||||
|
|
||||||
module Relative = struct
|
module TimeRelative = struct
|
||||||
type t = Int64.t
|
type t = Int64.t
|
||||||
|
|
||||||
let forever = uint64_max
|
let forever = uint64_max
|
||||||
|
|
@ -26,8 +26,7 @@ module Relative = struct
|
||||||
let v = Int64.mul s 1_000_000L in
|
let v = Int64.mul s 1_000_000L in
|
||||||
if Int64.unsigned_div v 1_000_000L <> s then forever else v
|
if Int64.unsigned_div v 1_000_000L <> s then forever else v
|
||||||
|
|
||||||
let bin = Bin.neint64
|
let bin = Bin.beint64
|
||||||
let bin_nbo = Bin.beint64
|
|
||||||
|
|
||||||
let caqti =
|
let caqti =
|
||||||
let encode v = Ok v in
|
let encode v = Ok v in
|
||||||
|
|
@ -57,7 +56,7 @@ module Relative = struct
|
||||||
|> Jsont.Object.finish
|
|> Jsont.Object.finish
|
||||||
end
|
end
|
||||||
|
|
||||||
module Absolute = struct
|
module TimeAbsolute = struct
|
||||||
type t = Int64.t
|
type t = Int64.t
|
||||||
|
|
||||||
let never = uint64_max
|
let never = uint64_max
|
||||||
|
|
@ -117,9 +116,8 @@ module Timestamp = struct
|
||||||
let of_absolute a =
|
let of_absolute a =
|
||||||
if a = never then never else Int64.sub a (Int64.unsigned_rem a 1_000_000L)
|
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 of_ptime v = v |> TimeAbsolute.of_ptime |> of_absolute
|
||||||
let bin = Bin.neint64
|
let bin = Bin.beint64
|
||||||
let bin_nbo = Bin.beint64
|
|
||||||
|
|
||||||
let caqti =
|
let caqti =
|
||||||
let encode v = Ok v in
|
let encode v = Ok v in
|
||||||
|
|
|
||||||
16
src/time.mli
16
src/time.mli
|
|
@ -1,4 +1,4 @@
|
||||||
module Relative : sig
|
module TimeRelative : sig
|
||||||
type t
|
type t
|
||||||
|
|
||||||
val forever : t
|
val forever : t
|
||||||
|
|
@ -12,12 +12,11 @@ module Relative : sig
|
||||||
|
|
||||||
(* - *)
|
(* - *)
|
||||||
val bin : t Bin.t
|
val bin : t Bin.t
|
||||||
val bin_nbo : t Bin.t
|
|
||||||
val caqti : t Caqti_type.t
|
val caqti : t Caqti_type.t
|
||||||
val jsont : t Jsont.t
|
val jsont : t Jsont.t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Absolute : sig
|
module TimeAbsolute : sig
|
||||||
type t
|
type t
|
||||||
|
|
||||||
val never : t
|
val never : t
|
||||||
|
|
@ -25,9 +24,9 @@ module Absolute : sig
|
||||||
val compare : t -> t -> int
|
val compare : t -> t -> int
|
||||||
val min : t -> t -> t
|
val min : t -> t -> t
|
||||||
val max : t -> t -> t
|
val max : t -> t -> t
|
||||||
val diff : t -> t -> Relative.t
|
val diff : t -> t -> TimeRelative.t
|
||||||
val add : t -> Relative.t -> t
|
val add : t -> TimeRelative.t -> t
|
||||||
val sub : t -> Relative.t -> t
|
val sub : t -> TimeRelative.t -> t
|
||||||
val of_s : int64 -> t
|
val of_s : int64 -> t
|
||||||
val of_ptime : Ptime.t -> t
|
val of_ptime : Ptime.t -> t
|
||||||
end
|
end
|
||||||
|
|
@ -40,18 +39,17 @@ module Timestamp : sig
|
||||||
val compare : t -> t -> int
|
val compare : t -> t -> int
|
||||||
val min : t -> t -> t
|
val min : t -> t -> t
|
||||||
val max : 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
|
val of_s : int64 -> t
|
||||||
|
|
||||||
(* none if t = never *)
|
(* none if t = never *)
|
||||||
val to_s : t -> int64 option
|
val to_s : t -> int64 option
|
||||||
val of_absolute : Absolute.t -> t
|
val of_absolute : TimeAbsolute.t -> t
|
||||||
val of_ptime : Ptime.t -> t
|
val of_ptime : Ptime.t -> t
|
||||||
|
|
||||||
(* TODO add pp *)
|
(* TODO add pp *)
|
||||||
(* - *)
|
(* - *)
|
||||||
val bin : t Bin.t
|
val bin : t Bin.t
|
||||||
val bin_nbo : t Bin.t
|
|
||||||
val caqti : t Caqti_type.t
|
val caqti : t Caqti_type.t
|
||||||
val jsont : t Jsont.t
|
val jsont : t Jsont.t
|
||||||
end
|
end
|
||||||
|
|
|
||||||
|
|
@ -14,16 +14,17 @@ open Offline_impl
|
||||||
|
|
||||||
module Arg = struct
|
module Arg = struct
|
||||||
include Arg
|
include Arg
|
||||||
|
open Time
|
||||||
|
|
||||||
(* in seconds *)
|
(* in seconds *)
|
||||||
let timestamp =
|
let timestamp =
|
||||||
let parser s =
|
let parser s =
|
||||||
match int_of_string_opt s with
|
match int_of_string_opt s with
|
||||||
| None -> Error "not an int"
|
| 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
|
in
|
||||||
let pp fmt t =
|
let pp fmt t =
|
||||||
match Time.Timestamp.to_s t with
|
match Timestamp.to_s t with
|
||||||
| None -> Fmt.pf fmt "never"
|
| None -> Fmt.pf fmt "never"
|
||||||
| Some s -> Fmt.pf fmt "%Ld" s
|
| Some s -> Fmt.pf fmt "%Ld" s
|
||||||
in
|
in
|
||||||
|
|
@ -34,11 +35,11 @@ module Arg = struct
|
||||||
let parser s =
|
let parser s =
|
||||||
match int_of_string_opt s with
|
match int_of_string_opt s with
|
||||||
| None -> Error "not an int"
|
| 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
|
in
|
||||||
let pp fmt d =
|
let pp fmt d =
|
||||||
let t = Time.Timestamp.of_absolute Time.Absolute.(add zero d) in
|
let t = Timestamp.of_absolute TimeAbsolute.(add zero d) in
|
||||||
match Time.Timestamp.to_s t with
|
match Timestamp.to_s t with
|
||||||
| None -> Fmt.pf fmt "never"
|
| None -> Fmt.pf fmt "never"
|
||||||
| Some s -> Fmt.pf fmt "%Ld" s
|
| Some s -> Fmt.pf fmt "%Ld" s
|
||||||
in
|
in
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue