diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 6a41afad7..be47c3829 100644 --- a/.gitlab-ci.yml +++ b/.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: - - master - - dev + only: + - merge_requests # 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 diff --git a/src/bin/cli.ml b/src/bin/cli.ml index edb571cd0..b12ce3eb1 100644 --- a/src/bin/cli.ml +++ b/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 ; ] diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 443102d80..66a9b140b 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/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' |}] \ No newline at end of file + * 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) |}] \ No newline at end of file diff --git a/src/bin/expect_tests/help_tests.ml b/src/bin/expect_tests/help_tests.ml index b385abd14..716837074 100644 --- a/src/bin/expect_tests/help_tests.ml +++ b/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. diff --git a/src/bin/expect_tests/misc_cli_commands.ml b/src/bin/expect_tests/misc_cli_commands.ml new file mode 100644 index 000000000..b18de4873 --- /dev/null +++ b/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"]} |} ]; \ No newline at end of file diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index 3fdb1e629..6d98bccc5 100644 --- a/src/main/compile/of_simplified.ml +++ b/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 \ No newline at end of file + 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 diff --git a/src/test/contracts/evaluation_tests.ligo b/src/test/contracts/evaluation_tests.ligo new file mode 100644 index 000000000..b531d4a7b --- /dev/null +++ b/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 ; \ No newline at end of file diff --git a/src/test/contracts/id.mligo b/src/test/contracts/id.mligo new file mode 100644 index 000000000..fd7b7c424 --- /dev/null +++ b/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) diff --git a/src/test/contracts/timelock_repeat.mligo b/src/test/contracts/timelock_repeat.mligo new file mode 100644 index 000000000..5efff81a9 --- /dev/null +++ b/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) diff --git a/src/test/id_tests.ml b/src/test/id_tests.ml new file mode 100644 index 000000000..c4b5c6182 --- /dev/null +++ b/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 ; +] diff --git a/src/test/test.ml b/src/test/test.ml index b63e1ad5f..2505721e0 100644 --- a/src/test/test.ml +++ b/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 ; ] ; () diff --git a/src/test/time_lock_repeat_tests.ml b/src/test/time_lock_repeat_tests.ml new file mode 100644 index 000000000..cc6fbbf1b --- /dev/null +++ b/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 ; + ] diff --git a/src/test/time_lock_tests.ml b/src/test/time_lock_tests.ml index 83830b11f..a3437461a 100644 --- a/src/test/time_lock_tests.ml +++ b/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 ; - ] \ No newline at end of file + ]