Commit 93b1f694 authored by Milo Davis's avatar Milo Davis Committed by Benjamin Canou

Michelson: Timestamp operations

parent 1344e699
Pipeline #13003985 passed with stages
in 17 minutes and 51 seconds
......@@ -398,6 +398,7 @@ ALPHA_MODULES := $(addprefix ${SRCDIR}/proto/alpha/, \
level_repr.ml \
seed_repr.ml \
script_int_repr.ml \
script_timestamp_repr.ml \
script_repr.ml \
contract_repr.ml \
roll_repr.ml \
......
......@@ -16,6 +16,7 @@
"Level_repr",
"Seed_repr",
"Script_int_repr",
"Script_timestamp_repr",
"Script_repr",
"Contract_repr",
"Roll_repr",
......
......@@ -923,18 +923,31 @@ VII - Domain specific operations
### Operations on timestamps
Timestamp immediates can be obtained by the `NOW` operation, or
retrieved from script parameters or globals. The only valid operations
are the addition of a (positive) number of seconds and the comparison.
retrieved from script parameters or globals.
* `ADD`
Increment / decrement a timestamp of the given number of seconds.
:: timestamp : nat : 'S -> timestamp : 'S
:: nat : timestamp : 'S -> timestamp : 'S
:: timestamp : int : 'S -> timestamp : 'S
:: int : timestamp : 'S -> timestamp : 'S
> ADD ; C / seconds : nat (t) : S => C / (seconds + t) : S
> ADD ; C / nat (t) : seconds : S => C / (t + seconds) : S
* `SUB`
Subtract a number of seconds from a timestamp.
:: timestamp : int : 'S -> timestamp : 'S
> SUB ; C / seconds : nat (t) : S => C / (seconds - t) : S
* `SUB`
Subtract two timestamps.
:: timestamp : timestamp : 'S -> int : 'S
> SUB ; C / seconds(t1) : seconds(t2) : S => C / (t1 - t2) : S
* `COMPARE`:
Timestamp comparison.
......
......@@ -25,6 +25,9 @@ let of_int64 n = Z.of_int64 n
let to_int x = try Some (Z.to_int x) with _ -> None
let of_int n = Z.of_int n
let of_zint x = x
let to_zint x = x
let add x y = Z.add x y
let sub x y = Z.sub x y
let mul x y = Z.mul x y
......
......@@ -50,6 +50,12 @@ val to_int : _ num -> int option
(** Conversion from an OCaml [int64]. *)
val of_int : int -> z num
(** Conversion from a Zarith integer ([Z.t]). *)
val of_zint : Z.t -> z num
(** Conversion to a Zarith integer ([Z.t]). *)
val to_zint : 'a num -> Z.t
(** Addition between naturals. *)
val add_n : n num -> n num -> n num
......
......@@ -18,8 +18,8 @@ let dummy_storage_fee = Tez.fifty_cents
(* ---- Run-time errors -----------------------------------------------------*)
type error += Quota_exceeded
type error += Overflow of Script.location
type error += Reject of Script.location
type error += Overflow of Script.location
type error += Runtime_contract_error : Contract.t * Script.expr * _ ty * _ ty * _ ty -> error
let () =
......@@ -34,16 +34,6 @@ let () =
empty
(function Quota_exceeded -> Some () | _ -> None)
(fun () -> Quota_exceeded) ;
register_error_kind
`Permanent
~id:"overflowRuntimeError"
~title: "Value overflow (runtime script error)"
~description:
"An integer or currency overflow happened \
during the execution of a script"
(obj1 (req "location" Script.location_encoding))
(function Overflow loc -> Some loc | _ -> None)
(fun loc -> Overflow loc) ;
register_error_kind
`Temporary
~id:"scriptRejectedRuntimeError"
......@@ -229,25 +219,13 @@ let rec interp
logged_return (Item (map_size map, rest), qta - 1, ctxt)
(* timestamp operations *)
| Add_seconds_to_timestamp, Item (n, Item (t, rest)) ->
begin match Script_int.to_int64 n with
| None -> fail (Overflow loc)
| Some n ->
Lwt.return
(Period.of_seconds n >>? fun p ->
Timestamp.(t +? p) >>? fun res ->
Ok (Item (res, rest), qta - 1, ctxt)) >>=? fun res ->
logged_return res
end
logged_return (Item (Script_timestamp.add_delta t n, rest), qta - 1, ctxt)
| Add_timestamp_to_seconds, Item (t, Item (n, rest)) ->
begin match Script_int.to_int64 n with
| None -> fail (Overflow loc)
| Some n ->
Lwt.return
(Period.of_seconds n >>? fun p ->
Timestamp.(t +? p) >>? fun res ->
Ok (Item (res, rest), qta - 1, ctxt)) >>=? fun res ->
logged_return res
end
logged_return (Item (Script_timestamp.add_delta t n, rest), qta - 1, ctxt)
| Sub_timestamp_seconds, Item (t, Item (s, rest)) ->
logged_return (Item (Script_timestamp.sub_delta t s, rest), qta - 1, ctxt)
| Diff_timestamps, Item (t1, Item (t2, rest)) ->
logged_return (Item (Script_timestamp.diff t1 t2, rest), qta - 1, ctxt)
(* string operations *)
| Concat, Item (x, Item (y, rest)) ->
logged_return (Item (x ^ y, rest), qta - 1, ctxt)
......@@ -427,7 +405,7 @@ let rec interp
let cmpres = Script_int.of_int cmpres in
logged_return (Item (cmpres, rest), qta - 1, ctxt)
| Compare Timestamp_key, Item (a, Item (b, rest)) ->
let cmpres = Timestamp.compare a b in
let cmpres = Script_timestamp.compare a b in
let cmpres = Script_int.of_int cmpres in
logged_return (Item (cmpres, rest), qta - 1, ctxt)
(* comparators *)
......@@ -541,7 +519,7 @@ let rec interp
Contract.get_balance ctxt source >>=? fun balance ->
logged_return (Item (balance, rest), qta - 1, ctxt)
| Now, rest ->
let now = Timestamp.current ctxt in
let now = Script_timestamp.now ctxt in
logged_return (Item (now, rest), qta - 1, ctxt)
| Check_signature, Item (key, Item ((signature, message), rest)) ->
let message = MBytes.of_string message in
......
......@@ -144,8 +144,7 @@ let compare_comparable
if Compare.Int.(res = 0) then 0
else if Compare.Int.(res > 0) then 1
else -1
| Timestamp_key -> Timestamp.compare x y
| Timestamp_key -> Script_timestamp.compare x y
let empty_set
: type a. a comparable_ty -> a set
......@@ -321,7 +320,11 @@ let rec unparse_data
| Bool_t, false ->
Prim (-1, "False", [], None)
| Timestamp_t, t ->
String (-1, Timestamp.to_notation t)
begin
match Script_timestamp.to_notation t with
| None -> Int (-1, Script_timestamp.to_num_str t)
| Some s -> String (-1, s)
end
| Contract_t _, (_, _, c) ->
String (-1, Contract.to_b58check c)
| Signature_t, s ->
......@@ -368,7 +371,7 @@ let rec unparse_data
Prim (-1, "Item",
[ unparse_data kt k;
unparse_data vt v ],
None)
None)
:: acc)
map [] in
Prim (-1, "Map", List.rev items, None)
......@@ -647,12 +650,12 @@ let rec parse_data
traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr)))
(* Timestamps *)
| Timestamp_t, (Int (_, v)) -> begin
match (Timestamp.of_seconds v) with
match Script_timestamp.of_string v with
| Some v -> return v
| None -> fail (error ())
end
| Timestamp_t, String (_, s) -> begin try
match Timestamp.of_notation s with
match Script_timestamp.of_string s with
| Some v -> return v
| None -> fail (error ())
with _ -> fail (error ())
......@@ -1090,11 +1093,17 @@ and parse_instr
return (Failed { descr })
(* timestamp operations *)
| Prim (loc, "ADD", [], annot),
Item_t (Timestamp_t, Item_t (Nat_t, rest)) ->
Item_t (Timestamp_t, Item_t (Int_t, rest)) ->
return (typed loc annot (Add_timestamp_to_seconds, Item_t (Timestamp_t, rest)))
| Prim (loc, "ADD", [], annot),
Item_t (Nat_t, Item_t (Timestamp_t, rest)) ->
Item_t (Int_t, Item_t (Timestamp_t, rest)) ->
return (typed loc annot (Add_seconds_to_timestamp, Item_t (Timestamp_t, rest)))
| Prim (loc, "SUB", [], annot),
Item_t (Timestamp_t, Item_t (Int_t, rest)) ->
return (typed loc annot (Sub_timestamp_seconds, Item_t (Timestamp_t, rest)))
| Prim (loc, "SUB", [], annot),
Item_t (Timestamp_t, Item_t (Timestamp_t, rest)) ->
return (typed loc annot (Diff_timestamps, Item_t (Int_t, rest)))
(* string operations *)
| Prim (loc, "CONCAT", [], annot),
Item_t (String_t, Item_t (String_t, rest)) ->
......
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <[email protected]> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
type t = Z.t
let compare = Z.compare
let of_int64 = Z.of_int64
let of_string x =
match Time_repr.of_notation x with
| None ->
begin try Some (Z.of_string x)
with _ -> None
end
| Some time ->
Some (of_int64 (Time_repr.to_seconds time))
let to_notation x =
try
let notation = Time_repr.to_notation (Time.of_seconds (Z.to_int64 x)) in
if String.equal notation "out_of_range"
then None
else Some notation
with _ -> None
let to_num_str = Z.to_string
let to_string x =
match to_notation x with
| None -> to_num_str x
| Some s -> s
let diff x y = Script_int_repr.of_zint @@ Z.sub x y
let sub_delta t delta = Z.sub t (Script_int_repr.to_zint delta)
let add_delta t delta =
Z.add t (Script_int_repr.to_zint delta)
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <[email protected]> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Script_int_repr
type t
val of_int64 : int64 -> t
val compare : t -> t -> int
(* Convert a timestamp to a notation if possible *)
val to_notation : t -> string option
(* Convert a timestamp to a string representation of the seconds *)
val to_num_str : t -> string
(* Convert to a notation if possible, or num if not *)
val to_string : t -> string
val of_string : string -> t option
val diff : t -> t -> z num
val add_delta : t -> z num -> t
val sub_delta : t -> z num -> t
......@@ -20,7 +20,7 @@ type 'ty comparable_ty =
| Tez_key : Tez.t comparable_ty
| Bool_key : bool comparable_ty
| Key_hash_key : public_key_hash comparable_ty
| Timestamp_key : Timestamp.t comparable_ty
| Timestamp_key : Script_timestamp.t comparable_ty
module type Boxed_set = sig
type elt
......@@ -68,7 +68,7 @@ and 'ty ty =
| Tez_t : Tez.t ty
| Key_hash_t : public_key_hash ty
| Key_t : public_key ty
| Timestamp_t : Timestamp.t ty
| Timestamp_t : Script_timestamp.t ty
| Bool_t : bool ty
| Pair_t : 'a ty * 'b ty -> ('a, 'b) pair ty
| Union_t : 'a ty * 'b ty -> ('a, 'b) union ty
......@@ -168,11 +168,18 @@ and ('bef, 'aft) instr =
| Concat :
(string * (string * 'rest), string * 'rest) instr
(* timestamp operations *)
(* TODO: check if we need int instead of nat *)
| Add_seconds_to_timestamp :
(n num * (Timestamp.t * 'rest), Timestamp.t * 'rest) instr
(z num * (Script_timestamp.t * 'rest),
Script_timestamp.t * 'rest) instr
| Add_timestamp_to_seconds :
(Timestamp.t * (n num * 'rest), Timestamp.t * 'rest) instr
(Script_timestamp.t * (z num * 'rest),
Script_timestamp.t * 'rest) instr
| Sub_timestamp_seconds :
(Script_timestamp.t * (z num * 'rest),
Script_timestamp.t * 'rest) instr
| Diff_timestamps :
(Script_timestamp.t * (Script_timestamp.t * 'rest),
z num * 'rest) instr
(* currency operations *)
(* TODO: we can either just have conversions to/from integers and
do all operations on integers, or we need more operations on
......@@ -296,7 +303,7 @@ and ('bef, 'aft) instr =
(('p * 'g, 'r * 'g) lambda * ('g * 'rest)))))),
('p, 'r) typed_contract * 'rest) instr
| Now :
('rest, Timestamp.t * 'rest) instr
('rest, Script_timestamp.t * 'rest) instr
| Balance :
('rest, Tez.t * 'rest) instr
| Check_signature :
......
......@@ -38,6 +38,13 @@ end
module Raw_level = Raw_level_repr
module Cycle = Cycle_repr
module Script_int = Script_int_repr
module Script_timestamp = struct
include Script_timestamp_repr
let now ctxt =
Storage.current_timestamp ctxt
|> Timestamp.to_seconds
|> of_int64
end
module Script = Script_repr
type public_key = Ed25519.Public_key.t
......
......@@ -73,9 +73,9 @@ module Timestamp : sig
val to_notation: time -> string
val of_seconds: string -> time option
val to_seconds: time -> string
val to_seconds_string: time -> string
val current: context -> Time.t
val current : context -> time
end
......@@ -109,6 +109,20 @@ end
module Script_int : module type of Script_int_repr
module Script_timestamp : sig
open Script_int
type t
val compare : t -> t -> int
val to_string : t -> string
val to_notation : t -> string option
val to_num_str : t -> string
val of_string : string -> t option
val diff : t -> t -> z num
val add_delta : t -> z num -> t
val sub_delta : t -> z num -> t
val now : context -> t
end
module Script : sig
type location = int
......
......@@ -15,7 +15,8 @@ type error += Timestamp_add of exn
let of_seconds s =
try Some (of_seconds (Int64.of_string s))
with _ -> None
let to_seconds s = Int64.to_string (to_seconds s)
let to_seconds = to_seconds
let to_seconds_string s = Int64.to_string (to_seconds s)
let pp = pp_hum
......
......@@ -12,7 +12,7 @@ type time = t
val pp: Format.formatter -> t -> unit
val of_seconds: string -> time option
val to_seconds: time -> string
val to_seconds_string: time -> string
val (+?) : time -> Period_repr.t -> time tzresult
parameter (pair int timestamp);
storage unit;
return timestamp;
code { CAR; DUP; CAR; DIP{CDR}; ADD; UNIT; SWAP; PAIR}
parameter (pair timestamp int);
storage unit;
return timestamp;
code { CAR; DUP; CAR; DIP{CDR}; ADD; UNIT; SWAP; PAIR}
parameter (pair timestamp timestamp);
return int;
storage unit;
code { CAR; DUP; CAR; DIP{CDR}; SUB; UNIT; SWAP; PAIR }
parameter (pair timestamp int);
storage unit;
return timestamp;
code { CAR; DUP; CAR; DIP{CDR}; SUB; UNIT; SWAP; PAIR}
......@@ -312,6 +312,24 @@ init_with_transfer $CONTRACT_PATH/store_now.tz $key1 '"2017-07-13T09:19:01Z"' "1
$client transfer 500 from bootstrap1 to store_now -arg Unit
assert_storage_contains store_now "$($client get timestamp)"
# Test timestamp operations
assert_output $CONTRACT_PATH/add_timestamp_delta.tz Unit '(Pair 100 100)' '"1970-01-01T00:03:20Z"'
assert_output $CONTRACT_PATH/add_timestamp_delta.tz Unit '(Pair 100 -100)' '"1970-01-01T00:00:00Z"'
assert_output $CONTRACT_PATH/add_timestamp_delta.tz Unit '(Pair "1970-01-01T00:00:00Z" 0)' '"1970-01-01T00:00:00Z"'
assert_output $CONTRACT_PATH/add_delta_timestamp.tz Unit '(Pair 100 100)' '"1970-01-01T00:03:20Z"'
assert_output $CONTRACT_PATH/add_delta_timestamp.tz Unit '(Pair -100 100)' '"1970-01-01T00:00:00Z"'
assert_output $CONTRACT_PATH/add_delta_timestamp.tz Unit '(Pair 0 "1970-01-01T00:00:00Z")' '"1970-01-01T00:00:00Z"'
assert_output $CONTRACT_PATH/sub_timestamp_delta.tz Unit '(Pair 100 100)' '"1970-01-01T00:00:00Z"'
assert_output $CONTRACT_PATH/sub_timestamp_delta.tz Unit '(Pair 100 -100)' '"1970-01-01T00:03:20Z"'
assert_output $CONTRACT_PATH/sub_timestamp_delta.tz Unit '(Pair 100 2000000000000000000)' -1999999999999999900
assert_output $CONTRACT_PATH/diff_timestamps.tz Unit '(Pair 0 0)' 0
assert_output $CONTRACT_PATH/diff_timestamps.tz Unit '(Pair 0 1)' -1
assert_output $CONTRACT_PATH/diff_timestamps.tz Unit '(Pair 1 0)' 1
assert_output $CONTRACT_PATH/diff_timestamps.tz Unit '(Pair "1970-01-01T00:03:20Z" "1970-01-01T00:00:00Z")' 200
# Tests TRANSFER_TO
$client originate account "test_transfer_account1" for $key1 transferring 100 from bootstrap1
$client originate account "test_transfer_account2" for $key1 transferring 20 from bootstrap1
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment