Michelson: Timestamp operations

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 \

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",

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.
 

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

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
 

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

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)) ->

src/proto/alpha/script_timestamp_repr.ml

@@ -0,0 +1,45 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    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)

src/proto/alpha/script_timestamp_repr.mli

@@ -0,0 +1,30 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    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

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 :

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

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

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
 

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
 

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}

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}

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 }

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}

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