diff --git a/src/Makefile.files b/src/Makefile.files index 6262c4e91..339ca4763 100644 --- a/src/Makefile.files +++ b/src/Makefile.files @@ -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 \ diff --git a/src/proto/alpha/TEZOS_PROTOCOL b/src/proto/alpha/TEZOS_PROTOCOL index 2a0949aba..6a92b52e8 100644 --- a/src/proto/alpha/TEZOS_PROTOCOL +++ b/src/proto/alpha/TEZOS_PROTOCOL @@ -16,6 +16,7 @@ "Level_repr", "Seed_repr", "Script_int_repr", + "Script_timestamp_repr", "Script_repr", "Contract_repr", "Roll_repr", diff --git a/src/proto/alpha/docs/language.md b/src/proto/alpha/docs/language.md index 28c338515..caa5cf78d 100644 --- a/src/proto/alpha/docs/language.md +++ b/src/proto/alpha/docs/language.md @@ -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. diff --git a/src/proto/alpha/script_int_repr.ml b/src/proto/alpha/script_int_repr.ml index b8cceb801..2b130ef16 100644 --- a/src/proto/alpha/script_int_repr.ml +++ b/src/proto/alpha/script_int_repr.ml @@ -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 diff --git a/src/proto/alpha/script_int_repr.mli b/src/proto/alpha/script_int_repr.mli index 581e5730a..8bb4acc2f 100644 --- a/src/proto/alpha/script_int_repr.mli +++ b/src/proto/alpha/script_int_repr.mli @@ -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 diff --git a/src/proto/alpha/script_interpreter.ml b/src/proto/alpha/script_interpreter.ml index 7e741aecb..45c138eee 100644 --- a/src/proto/alpha/script_interpreter.ml +++ b/src/proto/alpha/script_interpreter.ml @@ -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 diff --git a/src/proto/alpha/script_ir_translator.ml b/src/proto/alpha/script_ir_translator.ml index 106ba1b8d..fd5f0f812 100644 --- a/src/proto/alpha/script_ir_translator.ml +++ b/src/proto/alpha/script_ir_translator.ml @@ -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)) -> diff --git a/src/proto/alpha/script_timestamp_repr.ml b/src/proto/alpha/script_timestamp_repr.ml new file mode 100644 index 000000000..0bac6849c --- /dev/null +++ b/src/proto/alpha/script_timestamp_repr.ml @@ -0,0 +1,45 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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) diff --git a/src/proto/alpha/script_timestamp_repr.mli b/src/proto/alpha/script_timestamp_repr.mli new file mode 100644 index 000000000..a7397efcf --- /dev/null +++ b/src/proto/alpha/script_timestamp_repr.mli @@ -0,0 +1,30 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/proto/alpha/script_typed_ir.ml b/src/proto/alpha/script_typed_ir.ml index edf17a69b..58cd240c8 100644 --- a/src/proto/alpha/script_typed_ir.ml +++ b/src/proto/alpha/script_typed_ir.ml @@ -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 : diff --git a/src/proto/alpha/tezos_context.ml b/src/proto/alpha/tezos_context.ml index 3560cfb87..dce095471 100644 --- a/src/proto/alpha/tezos_context.ml +++ b/src/proto/alpha/tezos_context.ml @@ -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 diff --git a/src/proto/alpha/tezos_context.mli b/src/proto/alpha/tezos_context.mli index a98f1552e..766d84c9f 100644 --- a/src/proto/alpha/tezos_context.mli +++ b/src/proto/alpha/tezos_context.mli @@ -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 diff --git a/src/proto/alpha/time_repr.ml b/src/proto/alpha/time_repr.ml index 12be7e96c..e096ecb51 100644 --- a/src/proto/alpha/time_repr.ml +++ b/src/proto/alpha/time_repr.ml @@ -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 diff --git a/src/proto/alpha/time_repr.mli b/src/proto/alpha/time_repr.mli index 03fb842d3..0c6bffe11 100644 --- a/src/proto/alpha/time_repr.mli +++ b/src/proto/alpha/time_repr.mli @@ -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 diff --git a/test/contracts/add_delta_timestamp.tz b/test/contracts/add_delta_timestamp.tz new file mode 100644 index 000000000..b0a235731 --- /dev/null +++ b/test/contracts/add_delta_timestamp.tz @@ -0,0 +1,4 @@ +parameter (pair int timestamp); +storage unit; +return timestamp; +code { CAR; DUP; CAR; DIP{CDR}; ADD; UNIT; SWAP; PAIR} diff --git a/test/contracts/add_timestamp_delta.tz b/test/contracts/add_timestamp_delta.tz new file mode 100644 index 000000000..405cea517 --- /dev/null +++ b/test/contracts/add_timestamp_delta.tz @@ -0,0 +1,4 @@ +parameter (pair timestamp int); +storage unit; +return timestamp; +code { CAR; DUP; CAR; DIP{CDR}; ADD; UNIT; SWAP; PAIR} diff --git a/test/contracts/diff_timestamps.tz b/test/contracts/diff_timestamps.tz new file mode 100644 index 000000000..5655a866b --- /dev/null +++ b/test/contracts/diff_timestamps.tz @@ -0,0 +1,4 @@ +parameter (pair timestamp timestamp); +return int; +storage unit; +code { CAR; DUP; CAR; DIP{CDR}; SUB; UNIT; SWAP; PAIR } diff --git a/test/contracts/sub_timestamp_delta.tz b/test/contracts/sub_timestamp_delta.tz new file mode 100644 index 000000000..df7e98b35 --- /dev/null +++ b/test/contracts/sub_timestamp_delta.tz @@ -0,0 +1,4 @@ +parameter (pair timestamp int); +storage unit; +return timestamp; +code { CAR; DUP; CAR; DIP{CDR}; SUB; UNIT; SWAP; PAIR} diff --git a/test/test_contracts.sh b/test/test_contracts.sh index dbb853bc7..c89b7fba5 100755 --- a/test/test_contracts.sh +++ b/test/test_contracts.sh @@ -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