add timestamp.ml
This commit is contained in:
parent
d760a54b61
commit
6962399dba
10 changed files with 113 additions and 121 deletions
39
src/api.ml
39
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
|
||||
|
|
|
|||
|
|
@ -58,39 +58,31 @@ 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
|
||||
module Timestamp : Time_S = TIME
|
||||
module TimestampNBO : Time_S = TIME_NBO
|
||||
|
||||
(* -- Cryptographic primitives -- *)
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
@ -38,12 +38,15 @@ let make
|
|||
|
||||
let stamp_start = Ptime_clock.now () in
|
||||
let stamp_expire_withdraw =
|
||||
Util.ptime_add_span_exn stamp_start duration_withdraw
|
||||
Util.ptime_add_span_exn stamp_start duration_withdraw |> Option.some
|
||||
in
|
||||
let stamp_expire_deposit =
|
||||
Util.ptime_add_span_exn stamp_start duration_spend
|
||||
Util.ptime_add_span_exn stamp_start duration_spend |> Option.some
|
||||
in
|
||||
let stamp_expire_legal = Util.ptime_add_span_exn stamp_start duration_legal in
|
||||
let stamp_expire_legal =
|
||||
Util.ptime_add_span_exn stamp_start duration_legal |> Option.some
|
||||
in
|
||||
let stamp_start = Some stamp_start in
|
||||
|
||||
let open Mirage_crypto_pk.Rsa in
|
||||
let priv = generate ~bits:rsa_keysize () in
|
||||
|
|
|
|||
|
|
@ -28,11 +28,11 @@ 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
|
||||
None
|
||||
(* TODO time
|
||||
Ptime.diff stamp_start stamp_expire_withdraw |> Util.ptime_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 +41,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 +57,21 @@ 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 =
|
||||
None
|
||||
(* TODO time
|
||||
Ptime.diff stamp_start stamp_expire
|
||||
|> Util.ptime_of_span_exn
|
||||
|> TimeRelativeNBO.of_ptime
|
||||
*)
|
||||
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) =
|
||||
|
|
|
|||
15
src/pg.ml
15
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, \
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
@ -22,8 +22,11 @@ let generate () =
|
|||
let stamp_start = Ptime_clock.now () in
|
||||
let stamp_expire =
|
||||
Util.ptime_add_span_exn stamp_start Config.Exchange.signkey_legal_duration
|
||||
|> Option.some
|
||||
in
|
||||
let stamp_end = stamp_expire in
|
||||
let stamp_start = Some stamp_start 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 }
|
||||
|
|
|
|||
46
src/timestamp.ml
Normal file
46
src/timestamp.ml
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
type t = Ptime.t option
|
||||
|
||||
(* 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
|
||||
9
src/timestamp.mli
Normal file
9
src/timestamp.mli
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
(* TODO time
|
||||
not sure about this *)
|
||||
|
||||
type t = Ptime.t 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
|
||||
10
src/util.ml
10
src/util.ml
|
|
@ -1,15 +1,5 @@
|
|||
(* -- 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]"
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue