Merge branch 'dev' of gitlab.com:ligolang/ligo into dev

.gitlab-ci.yml

@@ -11,6 +11,14 @@ stages:
   - build_and_deploy_docker
   - build_and_deploy_website
 
+# TODO provide sensible CI for master
+dont-merge-to-master:
+  stage: test
+  script:
+    - "false"
+  only:
+    - master
+
 .build_binary: &build_binary
   # To run in sequence and save CPU usage, use stage: build_and_package_binaries
   stage: test
@@ -95,6 +103,9 @@ local-dune-job:
   artifacts:
     paths:
       - _coverage_all
+  only:
+    - merge_requests
+    - dev
 
 # Run a docker build without publishing to the registry
 build-current-docker-image:
@@ -105,9 +116,8 @@ build-current-docker-image:
   script:
     - sh scripts/build_docker_image.sh
     - sh scripts/test_cli.sh
-  except:
+  only:
-    - master
+    - merge_requests
-    - dev
 
 # When a MR/PR is merged to dev
 # take the previous build and publish it to Docker Hub
@@ -135,6 +145,8 @@ build-and-package-debian-9:
     target_os: "debian"
     target_os_version: "9"
   <<: *build_binary
+  only:
+    - dev
 
 build-and-package-debian-10:
   <<: *docker
@@ -145,6 +157,12 @@ build-and-package-debian-10:
     target_os: "debian"
     target_os_version: "10"
   <<: *build_binary
+  # this one is merge_requests and dev, because the debian 10 binary
+  # is used for build-current-docker-image and for
+  # build-and-publish-latest-docker-image
+  only:
+    - merge_requests
+    - dev
 
 build-and-package-ubuntu-18-04:
   <<: *docker
@@ -155,6 +173,8 @@ build-and-package-ubuntu-18-04:
     target_os: "ubuntu"
     target_os_version: "18.04"
   <<: *build_binary
+  only:
+    - dev
 
 build-and-package-ubuntu-19-04:
   <<: *docker
@@ -165,11 +185,12 @@ build-and-package-ubuntu-19-04:
     target_os: "ubuntu"
     target_os_version: "19.04"
   <<: *build_binary
+  only:
+    - dev
 
-# Pages are deployed from both master & dev, be careful not to override 'next'
+# Pages are deployed from dev, be careful not to override 'next'
 # in case something gets merged into 'dev' while releasing.
 pages:
   <<: *website_build
   only:
-    - master
     - dev

src/bin/cli.ml

@@ -285,7 +285,7 @@ let compile_storage =
     let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in
     let%bind (typed_param,_)  = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
     let%bind mini_c_param     = Compile.Of_typed.compile_expression typed_param in
-    let%bind compiled_param   = Compile.Of_mini_c.compile_expression mini_c_param in
+    let%bind compiled_param   = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in
     let%bind ()               = Compile.Of_typed.assert_equal_contract_type Check_storage entry_point typed_prg typed_param in
     let%bind ()               = Compile.Of_michelson.assert_equal_contract_type Check_storage michelson_prg compiled_param in
     let%bind options          = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in
@@ -374,7 +374,7 @@ let evaluate_value =
     let%bind compiled          = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in
     let%bind options           = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in
     let%bind michelson_output  = Run.run_no_failwith ~options compiled.expr compiled.expr_ty in
-    let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output 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 =
@@ -410,6 +410,19 @@ let dump_changelog =
   let doc = "Dump the LIGO changelog to stdout." in
   (Term.ret term , Term.info ~doc cmdname)
 
+let list_declarations =
+  let f source_file syntax =
+    toplevel ~display_format:(`Human_readable) @@
+    let%bind simplified_prg  = Compile.Of_source.compile source_file (Syntax_name syntax) in
+    let json_decl = List.map (fun decl -> `String decl) @@ Compile.Of_simplified.list_declarations simplified_prg in
+    ok @@ J.to_string @@ `Assoc [ ("source_file", `String source_file) ; ("declarations", `List json_decl) ]
+  in
+  let term =
+    Term.(const f $ source_file 0 $ syntax ) in
+  let cmdname = "list-declarations" in
+  let doc = "Subcommand: list all the top-level decalarations." in
+  (Term.ret term , Term.info ~doc cmdname)
+
 let run ?argv () =
   Term.eval_choice ?argv main [
     compile_file ;
@@ -425,5 +438,6 @@ let run ?argv () =
     print_cst ;
     print_ast ;
     print_typed_ast ;
-    print_mini_c
+    print_mini_c ;
+    list_declarations ;
   ]

src/bin/expect_tests/contract_tests.ml

@@ -1037,4 +1037,9 @@ let%expect_test _ =
     * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
     * Ask a question on our Discord: https://discord.gg/9rhYaEt
     * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
-    * Check the changelog by running 'ligo changelog' |}]
+    * Check the changelog by running 'ligo changelog' |}]
+
+let%expect_test _ =
+  run_ligo_good [ "compile-storage" ; contract "big_map.ligo" ; "main" ; "(big_map1,unit)" ] ;
+  [%expect {|
+    (Pair { Elt 23 0 ; Elt 42 0 } Unit) |}]

src/bin/expect_tests/help_tests.ml

@@ -44,6 +44,9 @@ let%expect_test _ =
                Subcommand: interpret the expression in the context initialized by
                the provided source file.
 
+           list-declarations
+               Subcommand: list all the top-level decalarations.
+
            measure-contract
                Subcommand: measure a contract's compiled size in bytes.
 
@@ -117,6 +120,9 @@ let%expect_test _ =
                Subcommand: interpret the expression in the context initialized by
                the provided source file.
 
+           list-declarations
+               Subcommand: list all the top-level decalarations.
+
            measure-contract
                Subcommand: measure a contract's compiled size in bytes.
 

src/bin/expect_tests/misc_cli_commands.ml

@@ -0,0 +1,22 @@
+open Cli_expect
+
+(* evaluate-value *)
+let%expect_test _ =
+  run_ligo_good [ "evaluate-value" ; "../../test/contracts/evaluation_tests.ligo" ; "a" ] ;
+  [%expect {|
+    {foo = +0 , bar = "bar"} |} ];
+
+  run_ligo_good [ "evaluate-value" ; "../../test/contracts/evaluation_tests.ligo" ; "b" ] ;
+  [%expect {|
+    2 |} ]
+
+(* list-declarations *)
+let%expect_test _ =
+  run_ligo_good [ "list-declarations" ; "../../test/contracts/loop.ligo" ] ;
+  [%expect {| {"source_file":"../../test/contracts/loop.ligo","declarations":["inner_capture_in_conditional_block","dummy","nested_for_collection_local_var","nested_for_collection","for_collection_map_k","for_collection_map_kv","for_collection_empty","for_collection_with_patches","for_collection_comp_with_acc","for_collection_proc_call","for_collection_rhs_capture","for_collection_if_and_local_var","for_collection_set","for_collection_list","for_sum","while_sum","counter"]} |} ];
+
+  run_ligo_good [ "list-declarations" ; "../../test/contracts/loop.mligo" ] ;
+  [%expect {| {"source_file":"../../test/contracts/loop.mligo","declarations":["counter_nest","aux_nest","counter","counter_simple","aux_simple"]} |} ];
+
+  run_ligo_good [ "list-declarations" ; "../../test/contracts/loop.religo" ] ;
+  [%expect {| {"source_file":"../../test/contracts/loop.religo","declarations":["counter_nest","aux_nest","counter","counter_simple","aux_simple"]} |} ];

src/main/compile/of_simplified.ml

@@ -21,4 +21,14 @@ let apply (entry_point : string) (param : Ast_simplified.expression) : Ast_simpl
   ok applied
 
 let pretty_print formatter (program : Ast_simplified.program) = 
-  Ast_simplified.PP.program formatter program
+  Ast_simplified.PP.program formatter program
+
+let list_declarations (program : Ast_simplified.program) : string list =
+  List.fold_left
+    (fun prev el -> 
+      let open Location in
+      let open Ast_simplified in
+      match el.wrap_content with
+      | Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev
+      | _ -> prev) 
+    [] program

src/test/contracts/evaluation_tests.ligo

@@ -0,0 +1,11 @@
+type myrec is record
+  foo : nat;
+  bar : string;
+end;
+
+const a : myrec = record
+  foo = 0n;
+  bar = "bar";
+end;
+
+const b : int = 2 ;

src/test/contracts/id.mligo

@@ -0,0 +1,139 @@
+type id = int
+
+type id_details = {
+  owner: address;
+  controller: address;
+  profile: bytes;
+}
+
+type buy = bytes * address option
+type update_owner = id * address
+type update_details = id * bytes option * address option
+
+type action =
+| Buy of buy
+| Update_owner of update_owner
+| Update_details of update_details
+| Skip of unit
+
+(* The prices kept in storage can be changed by bakers, though they should only be
+   adjusted down over time, not up. *)
+type storage = (id, id_details) big_map * int * (tez * tez)
+
+(** Preliminary thoughts on ids:
+
+I very much like the simplicity of http://gurno.com/adam/mne/.
+5 three letter words means you have a 15 character identity, not actually more
+annoying than an IP address and a lot more memorable than the raw digits. This
+can be stored as a single integer which is then translated into the corresponding
+series of 5 words.
+
+I in general like the idea of having a 'skip' mechanism, but it does need to cost
+something so people don't eat up the address space. 256 ^ 5 means you have a lot
+of address space, but if people troll by skipping a lot that could be eaten up.
+Should probably do some napkin calculations for how expensive skipping needs to
+be to deter people from doing it just to chew up address space.
+*)
+
+let buy (parameter, storage: (bytes * address option) * storage) =
+  let void: unit = 
+    if amount = storage.2.0 
+    then () 
+    else (failwith "Incorrect amount paid.": unit)
+  in
+  let profile, initial_controller = parameter in
+  let identities, new_id, prices = storage in
+  let controller: address =
+    match initial_controller with
+    | Some addr -> addr
+    | None -> sender
+  in
+  let new_id_details: id_details = {
+    owner = sender ;
+    controller = controller ;
+    profile = profile ;
+  }
+  in
+  let updated_identities: (id, id_details) big_map =
+    Big_map.update new_id (Some new_id_details) identities
+  in
+  ([]: operation list), (updated_identities, new_id + 1, prices)
+
+let update_owner (parameter, storage: (id * address) * storage) =
+  if (amount <> 0mutez)
+  then (failwith "Updating owner doesn't cost anything.": (operation list) * storage)
+  else
+  let id, new_owner = parameter in
+  let identities, last_id, prices = storage in
+  let current_id_details: id_details =
+    match Big_map.find_opt id identities with
+    | Some id_details -> id_details
+    | None -> (failwith "This ID does not exist.": id_details)
+  in
+  let is_allowed: bool =
+    if sender = current_id_details.owner
+    then true
+    else (failwith "You are not the owner of this ID.": bool)
+  in
+  let updated_id_details: id_details = {
+    owner = new_owner;
+    controller = current_id_details.controller;
+    profile = current_id_details.profile;
+  }
+  in
+  let updated_identities = Big_map.update id (Some updated_id_details) identities in
+  ([]: operation list), (updated_identities, last_id, prices)
+
+let update_details (parameter, storage: (id * bytes option * address option) * storage) =
+  if (amount <> 0mutez)
+  then (failwith "Updating details doesn't cost anything.": (operation list) * storage)
+  else
+  let id, new_profile, new_controller = parameter in
+  let identities, last_id, prices = storage in
+  let current_id_details: id_details =
+    match Big_map.find_opt id identities with
+    | Some id_details -> id_details
+    | None -> (failwith "This ID does not exist.": id_details)
+  in
+  let is_allowed: bool =
+    if (sender = current_id_details.controller) || (sender = current_id_details.owner)
+    then true
+    else (failwith ("You are not the owner or controller of this ID."): bool)
+  in
+  let owner: address = current_id_details.owner in
+  let profile: bytes =
+    match new_profile with
+    | None -> (* Default *) current_id_details.profile
+    | Some new_profile -> new_profile
+  in
+  let controller: address =
+    match new_controller with
+    | None -> (* Default *) current_id_details.controller
+    | Some new_controller -> new_controller
+  in
+  let updated_id_details: id_details = {
+    owner = owner;
+    controller = controller;
+    profile = profile;
+  }
+  in
+  let updated_identities: (id, id_details) big_map  =
+    Big_map.update id (Some updated_id_details) identities in
+  ([]: operation list), (updated_identities, last_id, prices)
+
+(* Let someone skip the next identity so nobody has to take one that's undesirable *)
+let skip (p,storage: unit * storage) =
+  let void: unit =
+    if amount = storage.2.1
+    then ()
+    else (failwith "Incorrect amount paid.": unit)
+  in
+  let identities, last_id, prices = storage in
+  ([]: operation list), (identities, last_id + 1, prices)
+
+let main (action, storage: action * storage) : operation list * storage =
+  match action with
+  | Buy b -> buy (b, storage)
+  | Update_owner uo -> update_owner (uo, storage)
+  | Update_details ud -> update_details (ud, storage)
+  | Skip s -> skip ((), storage)

src/test/contracts/timelock_repeat.mligo

@@ -0,0 +1,22 @@
+type storage = {
+  next_use: timestamp;
+  interval: int;
+  execute: unit -> operation list;
+}
+
+let main (p,s: unit * storage) : operation list * storage =
+  (* Multiple calls to Current.time give different values *)
+  let now: timestamp = Current.time in
+  if now > s.next_use
+  then
+    let s: storage = {
+                      next_use = now + s.interval;
+                      interval = s.interval;
+                      execute = s.execute;
+                      }
+    in
+    (s.execute (), s)
+  else
+    (* TODO: Add the time until next use to this message *)
+    (failwith "You have to wait before you can execute this contract again.":
+       operation list * storage)

src/test/id_tests.ml

@@ -0,0 +1,485 @@
+open Trace
+open Test_helpers
+open Ast_simplified
+
+
+let mtype_file f =
+  let%bind simplified  = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") 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 = mtype_file "./contracts/id.mligo" in
+        s := Some program ;
+        ok program
+      )
+
+let compile_main () =
+  let%bind simplified      = Ligo.Compile.Of_source.compile "./contracts/id.mligo" (Syntax_name "cameligo") 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 ()
+
+let (first_owner , first_contract) =
+  let open Proto_alpha_utils.Memory_proto_alpha in
+  let id = List.nth dummy_environment.identities 0 in
+  let kt = id.implicit_contract in
+  Protocol.Alpha_context.Contract.to_b58check kt , kt
+
+let buy_id () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1)]) ;
+                         e_int 1;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.one) ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address new_addr) ;
+                                  ("controller", e_address new_addr) ;
+                                  ("profile", new_website)]
+  in
+  let param = e_pair owner_website (e_some (e_address new_addr)) in
+  let new_storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                         (e_int 1, id_details_2)]) ;
+                              e_int 2;
+                              e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let%bind () = expect_eq ~options program "buy" 
+      (e_pair param storage) 
+      (e_pair (e_list []) new_storage)
+  in ok ()
+
+let buy_id_sender_addr () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1)]) ;
+                         e_int 1;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.one) ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address new_addr) ;
+                                  ("controller", e_address new_addr) ;
+                                  ("profile", new_website)]
+  in
+  let param = e_pair owner_website (e_typed_none t_address) in
+  let new_storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                         (e_int 1, id_details_2)]) ;
+                              e_int 2;
+                              e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let%bind () = expect_eq ~options program "buy" 
+      (e_pair param storage) 
+      (e_pair (e_list []) new_storage)
+  in ok ()
+
+(* Test that contract fails if we attempt to buy an ID for the wrong amount *)
+let buy_id_wrong_amount () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1)]) ;
+                         e_int 1;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.fifty_cents) ()
+  in
+  let param = e_pair owner_website (e_some (e_address new_addr)) in
+  let%bind () = expect_string_failwith ~options program "buy" 
+      (e_pair param storage) 
+      "Incorrect amount paid."
+  in ok ()
+
+let update_details_owner () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.zero) 
+      ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address new_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", new_website)]
+  in
+  let id_details_2_diff = e_ez_record [("owner", e_address new_addr) ;
+                                       ("controller", e_address new_addr) ;
+                                       ("profile", new_website)] in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                     (e_int 1, id_details_2)]) ;
+                         e_int 2;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let new_storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                         (e_int 1, id_details_2_diff)]) ;
+                             e_int 2;
+                             e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let details = e_bytes_string "ligolang.org" in
+  let param = e_tuple [e_int 1 ; 
+                       e_some details ;
+                       e_some (e_address new_addr)] in
+  let%bind () = expect_eq ~options program "update_details"
+      (e_pair param storage)
+      (e_pair (e_list []) new_storage)
+  in ok ()
+
+let update_details_controller () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.zero)
+      ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address new_addr) ;
+                                  ("profile", new_website)]
+  in
+  let id_details_2_diff = e_ez_record [("owner", e_address owner_addr) ;
+                                       ("controller", e_address owner_addr) ;
+                                       ("profile", new_website)] in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                     (e_int 1, id_details_2)]) ;
+                         e_int 2;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let new_storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                         (e_int 1, id_details_2_diff)]) ;
+                             e_int 2;
+                             e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let details = e_bytes_string "ligolang.org" in
+  let param = e_tuple [e_int 1 ; 
+                       e_some details ;
+                       e_some (e_address owner_addr)] in
+  let%bind () = expect_eq ~options program "update_details"
+      (e_pair param storage)
+      (e_pair (e_list []) new_storage)
+  in ok ()
+
+(* Test that contract fails when we attempt to update details of nonexistent ID *)
+let update_details_nonexistent () = 
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.zero)
+      ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address new_addr) ;
+                                  ("controller", e_address new_addr) ;
+                                  ("profile", new_website)]
+  in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                     (e_int 1, id_details_2)]) ;
+                         e_int 2;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let details = e_bytes_string "ligolang.org" in
+  let param = e_tuple [e_int 2 ; 
+                       e_some details ;
+                       e_some (e_address owner_addr)] in
+  let%bind () = expect_string_failwith ~options program "update_details"
+      (e_pair param storage)
+      "This ID does not exist."
+  in ok ()
+
+(* Test that contract fails when we attempt to update details from wrong addr *)
+let update_details_wrong_addr () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.zero)
+      ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address new_addr) ;
+                                  ("controller", e_address new_addr) ;
+                                  ("profile", new_website)]
+  in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                     (e_int 1, id_details_2)]) ;
+                         e_int 2;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let details = e_bytes_string "ligolang.org" in
+  let param = e_tuple [e_int 0 ; 
+                       e_some details ;
+                       e_some (e_address owner_addr)] in
+  let%bind () = expect_string_failwith ~options program "update_details"
+      (e_pair param storage)
+      "You are not the owner or controller of this ID."
+  in ok ()
+
+(* Test that giving none on both profile and controller address is a no-op *)
+let update_details_unchanged () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.zero)
+      ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address new_addr) ;
+                                  ("controller", e_address new_addr) ;
+                                  ("profile", new_website)]
+  in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                     (e_int 1, id_details_2)]) ;
+                         e_int 2;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let param = e_tuple [e_int 1 ; 
+                       e_typed_none t_bytes ;
+                       e_typed_none t_address] in
+  let%bind () = expect_eq ~options program "update_details"
+      (e_pair param storage)
+      (e_pair (e_list []) storage)
+  in ok ()
+
+let update_owner () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.zero)
+      ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address new_addr) ;
+                                  ("controller", e_address new_addr) ;
+                                  ("profile", new_website)]
+  in
+  let id_details_2_diff = e_ez_record [("owner", e_address owner_addr) ;
+                                       ("controller", e_address new_addr) ;
+                                       ("profile", new_website)] in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                     (e_int 1, id_details_2)]) ;
+                         e_int 2;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let new_storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                         (e_int 1, id_details_2_diff)]) ;
+                             e_int 2;
+                             e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let param = e_pair (e_int 1) (e_address owner_addr) in
+  let%bind () = expect_eq ~options program "update_owner"
+      (e_pair param storage)
+      (e_pair (e_list []) new_storage)
+  in ok ()
+
+(* Test that contract fails when we attempt to update owner of nonexistent ID *)
+let update_owner_nonexistent () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.zero)
+      ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address new_addr) ;
+                                  ("controller", e_address new_addr) ;
+                                  ("profile", new_website)]
+  in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                     (e_int 1, id_details_2)]) ;
+                         e_int 2;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let param = e_pair (e_int 2) (e_address new_addr) in
+  let%bind () = expect_string_failwith ~options program "update_owner"
+      (e_pair param storage)
+      "This ID does not exist."
+  in ok ()
+
+(* Test that contract fails when we attempt to update owner from non-owner addr *)
+let update_owner_wrong_addr () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.zero)
+      ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address new_addr) ;
+                                  ("controller", e_address new_addr) ;
+                                  ("profile", new_website)]
+  in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                     (e_int 1, id_details_2)]) ;
+                         e_int 2;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let param = e_pair (e_int 0) (e_address new_addr) in
+  let%bind () = expect_string_failwith ~options program "update_owner"
+      (e_pair param storage)
+      "You are not the owner of this ID."
+  in ok ()
+
+let skip () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.one) ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address new_addr) ;
+                                  ("controller", e_address new_addr) ;
+                                  ("profile", new_website)]
+  in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                     (e_int 1, id_details_2)]) ;
+                         e_int 2;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let new_storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                         (e_int 1, id_details_2)]) ;
+                             e_int 3;
+                             e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let%bind () = expect_eq ~options program "skip"
+      (e_pair (e_unit ()) storage)
+      (e_pair (e_list []) new_storage)
+  in ok ()
+
+(* Test that contract fails if we try to skip without paying the right amount *)
+let skip_wrong_amount () =
+  let%bind program, _ = get_program () in
+  let owner_addr = addr 5 in
+  let owner_website = e_bytes_string "ligolang.org" in
+  let id_details_1 = e_ez_record [("owner", e_address owner_addr) ;
+                                  ("controller", e_address owner_addr) ;
+                                  ("profile", owner_website)]
+  in
+  let new_addr = first_owner in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options
+      ~payer:first_contract
+      ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.fifty_cents) ()
+  in
+  let new_website = e_bytes_string "ligolang.org" in
+  let id_details_2 = e_ez_record [("owner", e_address new_addr) ;
+                                  ("controller", e_address new_addr) ;
+                                  ("profile", new_website)]
+  in
+  let storage = e_tuple [(e_big_map [(e_int 0, id_details_1) ;
+                                     (e_int 1, id_details_2)]) ;
+                         e_int 2;
+                         e_tuple [e_mutez 1000000 ; e_mutez 1000000]]
+  in
+  let%bind () = expect_string_failwith ~options program "skip"
+      (e_pair (e_unit ()) storage)
+      "Incorrect amount paid."
+  in ok ()
+
+let main = test_suite "ID Layer" [
+    test "buy"    buy_id ;
+    test "buy (sender addr)" buy_id_sender_addr ;
+    test "buy (wrong amount)" buy_id_wrong_amount ;
+    test "update_details (owner)" update_details_owner ;
+    test "update_details (controller)" update_details_controller ;
+    test "update_details_nonexistent" update_details_nonexistent ;
+    test "update_details_wrong_addr" update_details_wrong_addr ;
+    test "update_details_unchanged" update_details_unchanged ;
+    test "update_owner" update_owner ;
+    test "update_owner_nonexistent" update_owner_nonexistent ;
+    test "update_owner_wrong_addr" update_owner_wrong_addr ;
+    test "skip" skip ;
+    test "skip (wrong amount)" skip_wrong_amount ;
+]

src/test/test.ml

@@ -10,9 +10,11 @@ let () =
     Typer_tests.main ;
     Coase_tests.main ;
     Vote_tests.main ;
+    Id_tests.main ;
     Multisig_tests.main ;
     Multisig_v2_tests.main ;
     Replaceable_id_tests.main ;
     Time_lock_tests.main ;
+    Time_lock_repeat_tests.main ;
   ] ;
   ()

src/test/time_lock_repeat_tests.ml

@@ -0,0 +1,78 @@
+open Trace
+open Test_helpers
+open Ast_simplified
+
+let type_file f =
+  let%bind simplified  = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") 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/timelock_repeat.mligo" in
+        s := Some program ;
+        ok program
+      )
+
+let compile_main () = 
+  let%bind simplified      = Ligo.Compile.Of_source.compile "./contracts/timelock_repeat.mligo" (Syntax_name "cameligo") 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 ()
+
+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 interval execute =
+  e_ez_record [("next_use", e_timestamp (Int64.to_int @@ to_sec st)) ;
+               ("interval", e_int interval) ;
+               ("execute", execute)]
+
+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 86400 empty_message in
+  let options =
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in
+  let exp_failwith = "You have to wait before you can execute this contract again." in
+  expect_string_failwith ~options program "main"
+    (e_pair (e_unit ())  init_storage) exp_failwith
+
+let fake_uncompiled_empty_message = e_string "[lambda of type: (lambda unit (list operation)) ]"
+
+(* Test that when we use the contract the next use time advances by correct interval *)
+let interval_advance () =
+  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 86400 empty_message in
+  (* It takes a second for Current.now to be called, awful hack *)
+  let%bind new_timestamp = mk_time "2000-01-02T10:10:11Z" in
+  let new_storage_fake = storage new_timestamp 86400 fake_uncompiled_empty_message in
+  let options =
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in
+  expect_eq ~options program "main"
+  (e_pair (e_unit ()) init_storage) (e_pair empty_op_list new_storage_fake)
+
+let main = test_suite "Time Lock Repeating" [
+    test "compile" compile_main ;
+    test "early call" early_call ;
+    test "interval advance" interval_advance ;
+  ]

src/test/time_lock_tests.ml

@@ -27,14 +27,14 @@ let compile_main () =
   ok ()
 
 open Ast_simplified
-let empty_op_list = 
+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 = 
+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"
@@ -66,4 +66,4 @@ let main = test_suite "Time lock" [
     test "compile" compile_main ;
     test "early call" early_call ;
     test "call on time" call_on_time ;
-  ]
+  ]