Time lock : contract + tests

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,73 @@
+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 now = 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 =
+    let tezos_context = { Proto_alpha_utils.Memory_proto_alpha.dummy_environment.tezos_context with
+      predecessor_timestamp = now ; } in
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~tezos_context () 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 now = 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 =
+    let tezos_context = { Proto_alpha_utils.Memory_proto_alpha.dummy_environment.tezos_context with
+      predecessor_timestamp = now ; } in
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~tezos_context () 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 ;
+  ]