diff --git a/manifest/main.ml b/manifest/main.ml index f3bbd27a79166523c506ed45cdf910c498972253..b0857a3d58dc2c0d4ff5e60800d78a3a4063f38e 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -5112,6 +5112,7 @@ end = struct ("test_ticket_operations_diff", true); ("test_ticket_scanner", true); ("test_ticket_storage", true); + ("test_ticket_direct_spending", N.(number >= 019)); ("test_typechecking", true); ("test_lambda_normalization", N.(number >= 016)); ] diff --git a/src/proto_alpha/lib_parameters/default_parameters.ml b/src/proto_alpha/lib_parameters/default_parameters.ml index 9aef53823b8498bdb62af89ff3636a5403b57c64..a1328b3d985dab3c69b04a9bdf76e647f340ac70 100644 --- a/src/proto_alpha/lib_parameters/default_parameters.ml +++ b/src/proto_alpha/lib_parameters/default_parameters.ml @@ -278,6 +278,7 @@ let constants_mainnet = }; activation_vote_enable = false; }; + direct_ticket_spending_enable = false; } (* Sandbox and test networks's Dal cryptobox are computed by this function: diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index da2a79e21de37c47eb3b42672c50e3ebce70fde8..df9398660b83427e0c82b8469542ba4674c7ac9e 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -924,6 +924,7 @@ module Constants : sig sc_rollup : sc_rollup; zk_rollup : zk_rollup; adaptive_issuance : adaptive_issuance; + direct_ticket_spending_enable : bool; } val encoding : t Data_encoding.t @@ -1040,6 +1041,8 @@ module Constants : sig val zk_rollup_max_ticket_payload_size : context -> int + val direct_ticket_spending_enable : context -> bool + (** All constants: fixed and parametric *) type t = private {fixed : fixed; parametric : Parametric.t} diff --git a/src/proto_alpha/lib_protocol/constants_parametric_repr.ml b/src/proto_alpha/lib_protocol/constants_parametric_repr.ml index af3a850427dbc41044b22aaf3af23cfca1ae8c71..e978b7f0d4d03551724e30fbee674e771a543774 100644 --- a/src/proto_alpha/lib_protocol/constants_parametric_repr.ml +++ b/src/proto_alpha/lib_protocol/constants_parametric_repr.ml @@ -207,6 +207,7 @@ type t = { sc_rollup : sc_rollup; zk_rollup : zk_rollup; adaptive_issuance : adaptive_issuance; + direct_ticket_spending_enable : bool; } let sc_rollup_encoding = @@ -514,8 +515,10 @@ let encoding = ( ( c.cache_script_size, c.cache_stake_distribution_cycles, c.cache_sampler_state_cycles ), - (c.dal, ((c.sc_rollup, c.zk_rollup), c.adaptive_issuance)) ) ) - ) ) )) + ( c.dal, + ( (c.sc_rollup, c.zk_rollup), + (c.adaptive_issuance, c.direct_ticket_spending_enable) ) ) + ) ) ) ) )) (fun ( ( preserved_cycles, blocks_per_cycle, blocks_per_commitment, @@ -550,7 +553,10 @@ let encoding = ( ( cache_script_size, cache_stake_distribution_cycles, cache_sampler_state_cycles ), - (dal, ((sc_rollup, zk_rollup), adaptive_issuance)) ) ) ) ) ) -> + ( dal, + ( (sc_rollup, zk_rollup), + (adaptive_issuance, direct_ticket_spending_enable) ) ) ) + ) ) ) ) -> { preserved_cycles; blocks_per_cycle; @@ -590,6 +596,7 @@ let encoding = sc_rollup; zk_rollup; adaptive_issuance; + direct_ticket_spending_enable; }) (merge_objs (obj10 @@ -647,4 +654,6 @@ let encoding = (obj1 (req "dal_parametric" dal_encoding)) (merge_objs (merge_objs sc_rollup_encoding zk_rollup_encoding) - adaptive_issuance_encoding))))))) + (merge_objs + adaptive_issuance_encoding + (obj1 (req "direct_ticket_spending_enable" bool)))))))))) diff --git a/src/proto_alpha/lib_protocol/constants_parametric_repr.mli b/src/proto_alpha/lib_protocol/constants_parametric_repr.mli index 9e7c5d1d04bf1c1b2348207a9847cc6cdb826114..274b8ef65e48383254627909a1feaf71d4cd3ea5 100644 --- a/src/proto_alpha/lib_protocol/constants_parametric_repr.mli +++ b/src/proto_alpha/lib_protocol/constants_parametric_repr.mli @@ -196,6 +196,7 @@ type t = { sc_rollup : sc_rollup; zk_rollup : zk_rollup; adaptive_issuance : adaptive_issuance; + direct_ticket_spending_enable : bool; } val encoding : t Data_encoding.encoding diff --git a/src/proto_alpha/lib_protocol/constants_storage.ml b/src/proto_alpha/lib_protocol/constants_storage.ml index e7be304fc00fa6f8f873f5766197d577948e9fd5..cb74d1f1fdfdfd357230ccdf621d7ea56d3d7ac1 100644 --- a/src/proto_alpha/lib_protocol/constants_storage.ml +++ b/src/proto_alpha/lib_protocol/constants_storage.ml @@ -246,3 +246,6 @@ let adaptive_issuance_rewards_params c = let adaptive_issuance_activation_vote_enable c = (adaptive_issuance c).activation_vote_enable + +let direct_ticket_spending_enable c = + (Raw_context.constants c).direct_ticket_spending_enable diff --git a/src/proto_alpha/lib_protocol/constants_storage.mli b/src/proto_alpha/lib_protocol/constants_storage.mli index e539c0da9434d814ffb7d80795b22f4615c85614..fd325eaab8c58668c845236c1f26844128cb80cd 100644 --- a/src/proto_alpha/lib_protocol/constants_storage.mli +++ b/src/proto_alpha/lib_protocol/constants_storage.mli @@ -150,3 +150,5 @@ val adaptive_issuance_activation_vote_enable : Raw_context.t -> bool val adaptive_issuance_rewards_params : Raw_context.t -> Constants_parametric_repr.adaptive_rewards_params + +val direct_ticket_spending_enable : Raw_context.t -> bool diff --git a/src/proto_alpha/lib_protocol/raw_context.ml b/src/proto_alpha/lib_protocol/raw_context.ml index 685c350e6a23128efc75095e6b350585b630d15b..1fff2a8763065fb1daceddf6674ab484382c2031 100644 --- a/src/proto_alpha/lib_protocol/raw_context.ml +++ b/src/proto_alpha/lib_protocol/raw_context.ml @@ -1111,6 +1111,9 @@ let prepare_first_block ~level ~timestamp chain_id ctxt = Tez_repr.( div_exn c.minimal_stake (limit_of_delegation_over_baking + 1)) in + + let direct_ticket_spending_enable = false in + let constants = Constants_parametric_repr. { @@ -1156,6 +1159,7 @@ let prepare_first_block ~level ~timestamp chain_id ctxt = sc_rollup; zk_rollup; adaptive_issuance; + direct_ticket_spending_enable; } in let*! ctxt = add_constants ctxt constants in diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index fee974aeb0c0cd8adcf7182d57dc9d574f301392..f73dadacdcc705f192168a2d2692aa9bb8c3b35c 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -1767,10 +1767,13 @@ let lift_execution_arg (type a ac) ctxt ~internal (entrypoint_ty : (a, ac) ty) match arg with | Untyped_arg arg -> let arg = Micheline.root arg in + let allow_forged = + internal || Constants.direct_ticket_spending_enable ctxt + in parse_data ctxt ~elab_conf:Script_ir_translator_config.(make ~legacy:false ()) - ~allow_forged:internal + ~allow_forged entrypoint_ty arg | Typed_arg (loc, parsed_arg_ty, parsed_arg) -> diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/dune b/src/proto_alpha/lib_protocol/test/integration/michelson/dune index e30eacc1c5204e9c348ccbd9ef32c6c74a44382b..18fdd0d034c82d8ff71c34427784980af490466e 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/dune +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/dune @@ -54,6 +54,7 @@ test_ticket_operations_diff test_ticket_scanner test_ticket_storage + test_ticket_direct_spending test_typechecking test_lambda_normalization)) diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_direct_spending.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_direct_spending.ml new file mode 100644 index 0000000000000000000000000000000000000000..d53d09c2a13cb3ef72c47ffce6ca25f4541d4cb6 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_direct_spending.ml @@ -0,0 +1,163 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2023 Nomadic Labs *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Tickets, direct spending from implicit accounts + Invocation: dune exec src/proto_alpha/lib_protocol/test/integration/michelson/main.exe \ + -- --file test_ticket_direct_spending.ml + Subject: Test direct spending of tickets from implicit accounts +*) + +open Protocol +open Alpha_context + +let originate_contract ~code ~storage originator block = + let open Lwt_result_syntax in + let storage = Script.lazy_expr (Expr.from_string storage) in + let code = Script.lazy_expr (Expr.toplevel_from_string code) in + let script = Script.{code; storage} in + let* operation, contract_address = + Op.contract_origination ~script (B block) originator + in + let* block = Block.bake ~operation block in + return (contract_address, block) + +let call_contract ~source ~contract ?entrypoint ~arg block = + let open Lwt_result_syntax in + let arg = Script.lazy_expr (Expr.from_string arg) in + let* operation = + Op.transaction + ~parameters:arg + ?entrypoint + (B block) + source + contract + Tez.zero + in + Block.bake ~operation block + +let assert_ticket_balance ~ticketer ~expected_balance owner block = + let open Lwt_result_wrap_syntax in + let* incr = Incremental.begin_construction block in + let ctxt = Incremental.alpha_ctxt incr in + let token = + Ticket_token.Ex_token + {ticketer; contents_type = Script_typed_ir.unit_t; contents = ()} + in + let*@ key_hash, ctxt = Ticket_balance_key.of_ex_token ctxt ~owner token in + let*@ balance_opt, _ctxt = Ticket_balance.get_balance ctxt key_hash in + let balance = Option.value ~default:Z.zero balance_opt in + Assert.equal_z ~loc:__LOC__ balance (Z.of_int expected_balance) + +let ticket_boomerang_script = + {| +# This contract sends back a unit ticket of amount 1 to its sender +parameter unit; +storage unit; +code + { + DROP; + NIL operation; + SENDER; CONTRACT (ticket unit); ASSERT_SOME; + PUSH mutez 0; + PUSH nat 1; UNIT; TICKET; ASSERT_SOME; + TRANSFER_TOKENS; + CONS; + UNIT; SWAP; PAIR + } + |} + +let ticket_consumer_script = + {| +# This contract consumes a unit ticket +parameter (ticket unit); +storage unit; +code + { + CDR; + NIL operation; + PAIR + } +|} + +let test_spending ~direct_ticket_spending_enable () = + let open Lwt_result_syntax in + let constants = + let default_constants = + Tezos_protocol_alpha_parameters.Default_parameters.constants_test + in + { + default_constants with + consensus_threshold = 0; + direct_ticket_spending_enable; + } + in + let* block, (delegate, implicit) = Context.init_with_constants2 constants in + (* Originate a contract sending tickets to whoever ask for them. *) + let* boomerang, block = + originate_contract + ~code:ticket_boomerang_script + ~storage:"Unit" + delegate + block + in + let boomerang_str = Format.asprintf "%a" Contract.pp boomerang in + let* consumer, block = + originate_contract + ~code:ticket_consumer_script + ~storage:"Unit" + delegate + block + in + let* () = + assert_ticket_balance + ~ticketer:boomerang + ~expected_balance:0 + (Destination.Contract implicit) + block + in + let* block = + call_contract ~source:implicit ~contract:boomerang ~arg:"Unit" block + in + let* () = + assert_ticket_balance + ~ticketer:boomerang + ~expected_balance:1 + (Destination.Contract implicit) + block + in + let* block = + let arg = Printf.sprintf "Pair %S Unit 1" boomerang_str in + call_contract ~source:implicit ~contract:consumer ~arg block + in + let _destinations contract_hash rollup_addr = + Destination. + [ + Contract implicit; + Contract (Originated contract_hash); + Sc_rollup rollup_addr; + ] + in + let (_ : Block.t) = block in + return_unit + +let tests = + [ + Tztest.tztest + "Test ticket spending from implicit accounts (feature enabled)." + `Quick + (test_spending ~direct_ticket_spending_enable:true); + Tztest.tztest + "Test ticket spending from implicit accounts (feature disabled)." + `Quick + (test_spending ~direct_ticket_spending_enable:false); + ] + +let () = + Alcotest_lwt.run ~__FILE__ Protocol.name [("ticket direct spending", tests)] + |> Lwt_main.run