Merge branch 'contract-time-lock' into 'dev'

Contract time lock

See merge request ligolang/ligo!269

src/bin/cli.ml

@@ -66,7 +66,7 @@ let amount =
   let open Arg in
   let info =
     let docv = "AMOUNT" in
-    let doc = "$(docv) is the amount the dry-run transaction will use." in
+    let doc = "$(docv) is the amount the michelson interpreter will use." in
     info ~docv ~doc ["amount"] in
   value @@ opt string "0" info
 
@@ -74,7 +74,7 @@ let sender =
   let open Arg in
   let info =
     let docv = "SENDER" in
-    let doc = "$(docv) is the sender the dry-run transaction will use." in
+    let doc = "$(docv) is the sender the michelson interpreter transaction will use." in
     info ~docv ~doc ["sender"] in
   value @@ opt (some string) None info
 
@@ -82,10 +82,18 @@ let source =
   let open Arg in
   let info =
     let docv = "SOURCE" in
-    let doc = "$(docv) is the source the dry-run transaction will use." in
+    let doc = "$(docv) is the source the michelson interpreter transaction will use." in
     info ~docv ~doc ["source"] in
   value @@ opt (some string) None info
 
+let predecessor_timestamp =
+  let open Arg in
+  let info =
+    let docv = "PREDECESSOR_TIMESTAMP" in
+    let doc = "$(docv) is the pedecessor_timestamp the michelson interpreter transaction will use (e.g. '2000-01-01T10:10:10Z')" in
+    info ~docv ~doc ["predecessor-timestamp"] in
+  value @@ opt (some string) None info
+
 let display_format =
   let open Arg in
   let info  =
@@ -176,7 +184,7 @@ let compile_parameter =
   (Term.ret term , Term.info ~doc cmdname)
 
 let interpret =
-  let f expression init_file syntax amount sender source display_format =
+  let f expression init_file syntax amount sender source predecessor_timestamp display_format =
     toplevel ~display_format @@
     let%bind (decl_list,state,env) = match init_file with
       | Some init_file ->
@@ -192,13 +200,13 @@ let interpret =
     let%bind (typed_exp,_)     = Compile.Of_simplified.compile_expression ~env ~state simplified_exp in
     let%bind mini_c_exp        = Compile.Of_typed.compile_expression typed_exp in
     let%bind compiled_exp      = Compile.Of_mini_c.aggregate_and_compile_expression decl_list mini_c_exp in
-    let%bind options           = Run.make_dry_run_options {amount ; sender ; source } in
+    let%bind options           = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in
     let%bind value             = Run.run ~options compiled_exp.expr compiled_exp.expr_ty in
     let%bind simplified_output = Uncompile.uncompile_expression typed_exp.type_annotation value in
     ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
   in
   let term =
-    Term.(const f $ expression "EXPRESSION" 0 $ init_file $ syntax $ amount $ sender $ source $ display_format ) in
+    Term.(const f $ expression "EXPRESSION" 0 $ init_file $ syntax $ amount $ sender $ source $ predecessor_timestamp $ display_format ) in
   let cmdname = "interpret" in
   let doc = "Subcommand: interpret the expression in the context initialized by the provided source file." in
   (Term.ret term , Term.info ~doc cmdname)
@@ -233,7 +241,7 @@ let compile_storage =
   (Term.ret term , Term.info ~doc cmdname)
 
 let dry_run =
-  let f source_file entry_point storage input amount sender source syntax display_format =
+  let f source_file entry_point storage input amount sender source predecessor_timestamp syntax display_format =
     toplevel ~display_format @@
     let%bind simplified      = Compile.Of_source.compile source_file (Syntax_name syntax) in
     let%bind typed_prg,state = Compile.Of_simplified.compile simplified in
@@ -251,20 +259,20 @@ let dry_run =
     let%bind compiled_params   = Compile.Of_mini_c.compile_expression mini_c in
     let%bind args_michelson    = Run.evaluate_expression compiled_params.expr compiled_params.expr_ty in
 
-    let%bind options           = Run.make_dry_run_options {amount ; sender ; source } in
+    let%bind options           = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in
     let%bind michelson_output  = Run.run_contract ~options michelson_prg.expr michelson_prg.expr_ty args_michelson in
 
     let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in
     ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
   in
   let term =
-    Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ sender $ source $ syntax $ display_format) in
+    Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in
   let cmdname = "dry-run" in
   let doc = "Subcommand: run a smart-contract with the given storage and input." in
   (Term.ret term , Term.info ~doc cmdname)
 
 let run_function =
-  let f source_file entry_point parameter amount sender source syntax display_format =
+  let f source_file entry_point parameter amount sender source predecessor_timestamp syntax display_format =
     toplevel ~display_format @@
     let%bind v_syntax        = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
     let%bind simplified_prg  = Compile.Of_source.compile source_file (Syntax_name syntax) in
@@ -278,32 +286,32 @@ let run_function =
     let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in
 
     let%bind michelson         = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied in
-    let%bind options           = Run.make_dry_run_options {amount ; sender ; source } in
+    let%bind options           = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in
     let%bind michelson_output  = Run.run ~options michelson.expr michelson.expr_ty in
     let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in
     ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
   in
   let term =
-    Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ sender $ source $ syntax $ display_format) in
+    Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in
   let cmdname = "run-function" in
   let doc = "Subcommand: run a function with the given parameter." in
   (Term.ret term , Term.info ~doc cmdname)
 
 let evaluate_value =
-  let f source_file entry_point amount sender source syntax display_format =
+  let f source_file entry_point amount sender source predecessor_timestamp syntax display_format =
     toplevel ~display_format @@
     let%bind simplified        = Compile.Of_source.compile source_file (Syntax_name syntax) in
     let%bind typed_prg,_       = Compile.Of_simplified.compile simplified in
     let%bind mini_c            = Compile.Of_typed.compile typed_prg in
     let%bind (exp,_)           = Mini_c.get_entry mini_c entry_point in
     let%bind compiled          = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in
-    let%bind options           = Run.make_dry_run_options {amount ; sender ; source } in
+    let%bind options           = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in
     let%bind michelson_output  = Run.run ~options compiled.expr compiled.expr_ty in
     let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in
     ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
   in
   let term =
-    Term.(const f $ source_file 0 $ entry_point 1 $ amount $ sender $ source $ syntax $ display_format) in
+    Term.(const f $ source_file 0 $ entry_point 1 $ amount $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in
   let cmdname = "evaluate-value" in
   let doc = "Subcommand: evaluate a given definition." in
   (Term.ret term , Term.info ~doc cmdname)

src/bin/expect_tests/help_tests.ml

@@ -278,7 +278,7 @@ let%expect_test _ =
 
     OPTIONS
            --amount=AMOUNT (absent=0)
-               AMOUNT is the amount the dry-run transaction will use.
+               AMOUNT is the amount the michelson interpreter will use.
 
            --format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
            (absent=human-readable)
@@ -293,16 +293,22 @@ let%expect_test _ =
                `pager', `groff' or `plain'. With `auto', the format is `pager` or
                `plain' whenever the TERM env var is `dumb' or undefined.
 
+           --predecessor-timestamp=PREDECESSOR_TIMESTAMP
+               PREDECESSOR_TIMESTAMP is the pedecessor_timestamp the michelson
+               interpreter transaction will use (e.g. '2000-01-01T10:10:10Z')
+
            -s SYNTAX, --syntax=SYNTAX (absent=auto)
                SYNTAX is the syntax that will be used. Currently supported
                syntaxes are "pascaligo" and "cameligo". By default, the syntax is
                guessed from the extension (.ligo and .mligo, respectively).
 
            --sender=SENDER
-               SENDER is the sender the dry-run transaction will use.
+               SENDER is the sender the michelson interpreter transaction will
+               use.
 
            --source=SOURCE
-               SOURCE is the source the dry-run transaction will use.
+               SOURCE is the source the michelson interpreter transaction will
+               use.
 
            --version
                Show version information. |} ] ;
@@ -330,7 +336,7 @@ let%expect_test _ =
 
     OPTIONS
            --amount=AMOUNT (absent=0)
-               AMOUNT is the amount the dry-run transaction will use.
+               AMOUNT is the amount the michelson interpreter will use.
 
            --format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
            (absent=human-readable)
@@ -345,16 +351,22 @@ let%expect_test _ =
                `pager', `groff' or `plain'. With `auto', the format is `pager` or
                `plain' whenever the TERM env var is `dumb' or undefined.
 
+           --predecessor-timestamp=PREDECESSOR_TIMESTAMP
+               PREDECESSOR_TIMESTAMP is the pedecessor_timestamp the michelson
+               interpreter transaction will use (e.g. '2000-01-01T10:10:10Z')
+
            -s SYNTAX, --syntax=SYNTAX (absent=auto)
                SYNTAX is the syntax that will be used. Currently supported
                syntaxes are "pascaligo" and "cameligo". By default, the syntax is
                guessed from the extension (.ligo and .mligo, respectively).
 
            --sender=SENDER
-               SENDER is the sender the dry-run transaction will use.
+               SENDER is the sender the michelson interpreter transaction will
+               use.
 
            --source=SOURCE
-               SOURCE is the source the dry-run transaction will use.
+               SOURCE is the source the michelson interpreter transaction will
+               use.
 
            --version
                Show version information. |} ] ;
@@ -377,7 +389,7 @@ let%expect_test _ =
 
     OPTIONS
            --amount=AMOUNT (absent=0)
-               AMOUNT is the amount the dry-run transaction will use.
+               AMOUNT is the amount the michelson interpreter will use.
 
            --format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
            (absent=human-readable)
@@ -392,16 +404,22 @@ let%expect_test _ =
                `pager', `groff' or `plain'. With `auto', the format is `pager` or
                `plain' whenever the TERM env var is `dumb' or undefined.
 
+           --predecessor-timestamp=PREDECESSOR_TIMESTAMP
+               PREDECESSOR_TIMESTAMP is the pedecessor_timestamp the michelson
+               interpreter transaction will use (e.g. '2000-01-01T10:10:10Z')
+
            -s SYNTAX, --syntax=SYNTAX (absent=auto)
                SYNTAX is the syntax that will be used. Currently supported
                syntaxes are "pascaligo" and "cameligo". By default, the syntax is
                guessed from the extension (.ligo and .mligo, respectively).
 
            --sender=SENDER
-               SENDER is the sender the dry-run transaction will use.
+               SENDER is the sender the michelson interpreter transaction will
+               use.
 
            --source=SOURCE
-               SOURCE is the source the dry-run transaction will use.
+               SOURCE is the source the michelson interpreter transaction will
+               use.
 
            --version
                Show version information. |} ] ;

src/main/run/of_michelson.ml

@@ -16,6 +16,7 @@ type run_failwith_res =
 
 type dry_run_options =
   { amount : string ;
+    predecessor_timestamp : string option ;
     sender : string option ;
     source : string option }
 
@@ -44,7 +45,14 @@ let make_dry_run_options (opts : dry_run_options) : options result =
           (simple_error "invalid source address")
           (Contract.of_b58check source) in
       ok (Some source) in
-  ok @@ make_options ~amount ?source:sender ?payer:source ()
+  let%bind predecessor_timestamp =
+    match opts.predecessor_timestamp with
+    | None -> ok None
+    | Some st ->
+      match Memory_proto_alpha.Protocol.Alpha_context.Timestamp.of_notation st with
+        | Some t -> ok (Some t)
+        | None -> simple_fail ("\""^st^"\" is a bad timestamp notation") in
+  ok @@ make_options ?predecessor_timestamp:predecessor_timestamp ~amount ?source:sender ?payer:source ()
 
 let ex_value_ty_to_michelson (v : ex_typed_value) : Michelson.t result =
   let (Ex_typed_value (value , ty)) = v in

src/test/contracts/time-lock.ligo

@@ -0,0 +1,25 @@
+type storage_t is timestamp
+
+type message_t is (unit -> list(operation))
+type default_pt is unit
+type call_pt is message_t
+type contract_return_t is (list(operation) * storage_t)
+
+type entry_point_t is
+| Call of call_pt
+| Default of default_pt
+
+function call (const p : call_pt; const s : storage_t) : contract_return_t is block {
+  if s >= now then failwith("Contract is still time locked") else skip ;
+  const message : message_t = p ;
+  const ret_ops : list(operation) = message(unit) ;
+} with (ret_ops,s)
+
+function default (const p : default_pt; const s : storage_t) : contract_return_t is
+  ((nil: list(operation)) , s)
+
+function main(const param : entry_point_t; const s : storage_t) : contract_return_t is 
+  case param of
+  | Call     (p) -> call(p,s)
+  | Default  (p) -> default(p,s)
+end

src/test/test.ml

@@ -13,5 +13,6 @@ let () =
     Multisig_tests.main ;
     Multisig_v2_tests.main ;
     Replaceable_id_tests.main ;
+    Time_lock_tests.main ;
   ] ;
   ()

src/test/time_lock_tests.ml

@@ -0,0 +1,69 @@
+open Trace
+open Test_helpers
+
+let type_file f = 
+  let%bind simplified  = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in
+  let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
+  ok @@ (typed,state)
+
+let get_program =
+  let s = ref None in
+  fun () -> match !s with
+    | Some s -> ok s
+    | None -> (
+        let%bind program = type_file "./contracts/time-lock.ligo" in
+        s := Some program ;
+        ok program
+      )
+
+let compile_main () = 
+  let%bind simplified      = Ligo.Compile.Of_source.compile "./contracts/time-lock.ligo" (Syntax_name "pascaligo") in
+  let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in
+  let%bind mini_c_prg      = Ligo.Compile.Of_typed.compile typed_prg in
+  let%bind michelson_prg   = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
+  let%bind (_contract: Tezos_utils.Michelson.michelson) =
+    (* fails if the given entry point is not a valid contract *)
+    Ligo.Compile.Of_michelson.build_contract michelson_prg in
+  ok ()
+
+open Ast_simplified
+let empty_op_list = 
+  (e_typed_list [] t_operation)
+let empty_message = e_lambda (Var.of_name "arguments")
+  (Some t_unit) (Some (t_list t_operation))
+  empty_op_list
+
+let call msg = e_constructor "Call" msg
+let mk_time st = 
+  match Memory_proto_alpha.Protocol.Alpha_context.Timestamp.of_notation st with
+  | Some s -> ok s
+  | None -> simple_fail "bad timestamp notation"
+let to_sec t = Tezos_utils.Time.Protocol.to_seconds t
+let storage st = e_timestamp (Int64.to_int @@ to_sec st)
+
+let early_call () =
+  let%bind program,_ = get_program () in
+  let%bind predecessor_timestamp = mk_time "2000-01-01T00:10:10Z" in
+  let%bind lock_time = mk_time "2000-01-01T10:10:10Z" in
+  let init_storage = storage lock_time in
+  let options =
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in
+  let exp_failwith = "Contract is still time locked" in
+  expect_string_failwith ~options program "main"
+    (e_pair (call empty_message)  init_storage) exp_failwith
+
+let call_on_time () =
+  let%bind program,_ = get_program () in
+  let%bind predecessor_timestamp = mk_time "2000-01-01T10:10:10Z" in
+  let%bind lock_time = mk_time "2000-01-01T00:10:10Z" in
+  let init_storage = storage lock_time in
+  let options =
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in
+  expect_eq ~options program "main"
+    (e_pair (call empty_message) init_storage) (e_pair empty_op_list init_storage)
+
+let main = test_suite "Time lock" [
+    test "compile" compile_main ;
+    test "early call" early_call ;
+    test "call on time" call_on_time ;
+  ]

vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml

@@ -1066,13 +1066,16 @@ type options = {
 
 let make_options
     ?(tezos_context = dummy_environment.tezos_context)
+    ?(predecessor_timestamp = dummy_environment.tezos_context.predecessor_timestamp)
     ?(source = (List.nth dummy_environment.identities 0).implicit_contract)
     ?(self = (List.nth dummy_environment.identities 0).implicit_contract)
     ?(payer = (List.nth dummy_environment.identities 1).implicit_contract)
     ?(amount = Alpha_context.Tez.one)
     ?(chain_id = Environment.Chain_id.zero)
     ()
-  = {
+  =
+  let tezos_context = { tezos_context with predecessor_timestamp } in
+  {
     tezos_context ;
     source ;
     self ;

vendors/ligo-utils/tezos-protocol-alpha/alpha_context.mli

@@ -30,7 +30,7 @@ module type BASIC_DATA = sig
   val pp: Format.formatter -> t -> unit
 end
 
-type t
+type t = Raw_context.t
 type context = t
 
 type public_key = Signature.Public_key.t

vendors/ligo-utils/tezos-protocol-alpha/raw_context.mli

@@ -45,7 +45,34 @@ val storage_error: storage_error -> 'a tzresult Lwt.t
 (** Abstract view of the context.
     Includes a handle to the functional key-value database
     ({!Context.t}) along with some in-memory values (gas, etc.). *)
-type t
+module Int_set : sig
+  type t
+end
+type t = {
+  context: Context.t ;
+  constants: Constants_repr.parametric ;
+  first_level: Raw_level_repr.t ;
+  level: Level_repr.t ;
+  predecessor_timestamp: Time.t ;
+  timestamp: Time.t ;
+  fitness: Int64.t ;
+  deposits: Tez_repr.t Signature.Public_key_hash.Map.t ;
+  included_endorsements: int ;
+  allowed_endorsements:
+    (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ;
+  fees: Tez_repr.t ;
+  rewards: Tez_repr.t ;
+  block_gas: Z.t ;
+  operation_gas: Gas_limit_repr.t ;
+  internal_gas: Gas_limit_repr.internal_gas ;
+  storage_space_to_pay: Z.t option ;
+  allocated_contracts: int option ;
+  origination_nonce: Contract_repr.origination_nonce option ;
+  temporary_big_map: Z.t ;
+  internal_nonce: int ;
+  internal_nonces_used: Int_set.t ;
+}
+
 type context = t
 type root_context = t