diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml index 317cb13503d5cec2ef7459384ab471639d30e16a..7640d77ced93f9fec484130c26763dd4ac2b0e97 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml @@ -93,61 +93,107 @@ type 'ret continuation = unit -> 'ret tzresult This function checks whether or not a type can be used for a rollup. *) let rec validate_ty : type a ac ret. - (a, ac) Script_typed_ir.ty -> ret continuation -> ret tzresult = - fun ty k -> + (a, ac) Script_typed_ir.ty -> + a Script_typed_ir.entrypoints_node -> + ret continuation -> + ret tzresult = + fun ty {nested = nested_entrypoints; at_node} k -> let open Script_typed_ir in - match ty with - (* Valid primitive types. *) - | Unit_t -> (k [@ocaml.tailcall]) () - | Int_t -> (k [@ocaml.tailcall]) () - | Nat_t -> (k [@ocaml.tailcall]) () - | Signature_t -> (k [@ocaml.tailcall]) () - | String_t -> (k [@ocaml.tailcall]) () - | Bytes_t -> (k [@ocaml.tailcall]) () - | Key_hash_t -> (k [@ocaml.tailcall]) () - | Key_t -> (k [@ocaml.tailcall]) () - | Timestamp_t -> (k [@ocaml.tailcall]) () - | Address_t -> (k [@ocaml.tailcall]) () - | Bls12_381_g1_t -> (k [@ocaml.tailcall]) () - | Bls12_381_g2_t -> (k [@ocaml.tailcall]) () - | Bls12_381_fr_t -> (k [@ocaml.tailcall]) () - | Bool_t -> (k [@ocaml.tailcall]) () - | Never_t -> (k [@ocaml.tailcall]) () - | Tx_rollup_l2_address_t -> (k [@ocaml.tailcall]) () - | Chain_id_t -> (k [@ocaml.tailcall]) () - (* Valid collection types. *) - | Ticket_t (ty, _) -> (validate_ty [@ocaml.tailcall]) ty k - | Set_t (ty, _) -> (validate_ty [@ocaml.tailcall]) ty k - | Option_t (ty, _, _) -> (validate_ty [@ocaml.tailcall]) ty k - | List_t (ty, _) -> (validate_ty [@ocaml.tailcall]) ty k - | Pair_t (ty1, ty2, _, _) -> (validate_two_tys [@ocaml.tailcall]) ty1 ty2 k - | Union_t (ty1, ty2, _, _) -> (validate_two_tys [@ocaml.tailcall]) ty1 ty2 k - | Map_t (key_ty, val_ty, _) -> - (validate_two_tys [@ocaml.tailcall]) key_ty val_ty k - (* Invalid types. *) - | Mutez_t -> error Sc_rollup_invalid_parameters_type - | Big_map_t (_key_ty, _val_ty, _) -> error Sc_rollup_invalid_parameters_type - | Contract_t _ -> error Sc_rollup_invalid_parameters_type - | Sapling_transaction_t _ -> error Sc_rollup_invalid_parameters_type - | Sapling_transaction_deprecated_t _ -> + match at_node with + | Some {name = _; original_type_expr = _} -> + (* TODO: https://gitlab.com/tezos/tezos/-/issues/4023 + We currently don't support entrypoints as the entrypoint information + for L1 to L2 messages is not propagated to the rollup. *) error Sc_rollup_invalid_parameters_type - | Sapling_state_t _ -> error Sc_rollup_invalid_parameters_type - | Operation_t -> error Sc_rollup_invalid_parameters_type - | Chest_t -> error Sc_rollup_invalid_parameters_type - | Chest_key_t -> error Sc_rollup_invalid_parameters_type - | Lambda_t (_, _, _) -> error Sc_rollup_invalid_parameters_type + | None -> ( + match ty with + (* Valid primitive types. *) + | Unit_t -> (k [@ocaml.tailcall]) () + | Int_t -> (k [@ocaml.tailcall]) () + | Nat_t -> (k [@ocaml.tailcall]) () + | Signature_t -> (k [@ocaml.tailcall]) () + | String_t -> (k [@ocaml.tailcall]) () + | Bytes_t -> (k [@ocaml.tailcall]) () + | Key_hash_t -> (k [@ocaml.tailcall]) () + | Key_t -> (k [@ocaml.tailcall]) () + | Timestamp_t -> (k [@ocaml.tailcall]) () + | Address_t -> (k [@ocaml.tailcall]) () + | Bls12_381_g1_t -> (k [@ocaml.tailcall]) () + | Bls12_381_g2_t -> (k [@ocaml.tailcall]) () + | Bls12_381_fr_t -> (k [@ocaml.tailcall]) () + | Bool_t -> (k [@ocaml.tailcall]) () + | Never_t -> (k [@ocaml.tailcall]) () + | Tx_rollup_l2_address_t -> (k [@ocaml.tailcall]) () + | Chain_id_t -> (k [@ocaml.tailcall]) () + (* Valid collection types. *) + | Ticket_t (ty, _) -> (validate_ty [@ocaml.tailcall]) ty no_entrypoints k + | Set_t (ty, _) -> (validate_ty [@ocaml.tailcall]) ty no_entrypoints k + | Option_t (ty, _, _) -> + (validate_ty [@ocaml.tailcall]) ty no_entrypoints k + | List_t (ty, _) -> (validate_ty [@ocaml.tailcall]) ty no_entrypoints k + | Pair_t (ty1, ty2, _, _) -> + (* Entrypoints may not be nested in pairs, hence the no_entrypoints + value. *) + (validate_two_tys [@ocaml.tailcall]) + ty1 + ty2 + no_entrypoints + no_entrypoints + k + | Union_t (ty1, ty2, _, _) -> + let entrypoints_l, entrypoints_r = + match nested_entrypoints with + | Entrypoints_None -> (no_entrypoints, no_entrypoints) + | Entrypoints_Union {left; right} -> (left, right) + in + (validate_two_tys [@ocaml.tailcall]) + ty1 + ty2 + entrypoints_l + entrypoints_r + k + | Map_t (key_ty, val_ty, _) -> + (* Entrypoints may not be nested in maps, hence the no_entrypoints + value. *) + (validate_two_tys [@ocaml.tailcall]) + key_ty + val_ty + no_entrypoints + no_entrypoints + k + (* Invalid types. *) + | Mutez_t -> error Sc_rollup_invalid_parameters_type + | Big_map_t (_key_ty, _val_ty, _) -> + error Sc_rollup_invalid_parameters_type + | Contract_t _ -> error Sc_rollup_invalid_parameters_type + | Sapling_transaction_t _ -> error Sc_rollup_invalid_parameters_type + | Sapling_transaction_deprecated_t _ -> + error Sc_rollup_invalid_parameters_type + | Sapling_state_t _ -> error Sc_rollup_invalid_parameters_type + | Operation_t -> error Sc_rollup_invalid_parameters_type + | Chest_t -> error Sc_rollup_invalid_parameters_type + | Chest_key_t -> error Sc_rollup_invalid_parameters_type + | Lambda_t (_, _, _) -> error Sc_rollup_invalid_parameters_type) and validate_two_tys : type a ac b bc ret. (a, ac) Script_typed_ir.ty -> (b, bc) Script_typed_ir.ty -> + a Script_typed_ir.entrypoints_node -> + b Script_typed_ir.entrypoints_node -> ret continuation -> ret tzresult = - fun ty1 ty2 k -> - (validate_ty [@ocaml.tailcall]) ty1 (fun () -> - (validate_ty [@ocaml.tailcall]) ty2 k) + fun ty1 ty2 entrypoints1 entrypoints2 k -> + (validate_ty [@ocaml.tailcall]) ty1 entrypoints1 (fun () -> + (validate_ty [@ocaml.tailcall]) ty2 entrypoints2 k) -let validate_parameters_ty ctxt parameters_ty = +let validate_parameters_ty : + type a ac. + context -> + (a, ac) Script_typed_ir.ty -> + a Script_typed_ir.entrypoints_node -> + context tzresult = + fun ctxt parameters_ty entrypoints -> let open Result_syntax in let* ctxt = Gas.consume @@ -155,7 +201,7 @@ let validate_parameters_ty ctxt parameters_ty = (Sc_rollup_costs.is_valid_parameters_ty_cost ~ty_size:Script_typed_ir.(ty_size parameters_ty |> Type_size.to_int)) in - let+ () = validate_ty parameters_ty ok in + let+ () = validate_ty parameters_ty entrypoints ok in ctxt let validate_untyped_parameters_ty ctxt parameters_ty = @@ -164,14 +210,22 @@ let validate_untyped_parameters_ty ctxt parameters_ty = [parse_parameter_ty_and_entrypoints] restricts to [passable] types (everything but operations), which is OK since [validate_ty] constraints the type further. *) - let* Ex_parameter_ty_and_entrypoints {arg_type; entrypoints = _}, ctxt = + let* ( Ex_parameter_ty_and_entrypoints + { + arg_type; + entrypoints = + {Script_typed_ir.root = entrypoint; original_type_expr = _}; + }, + ctxt ) = Script_ir_translator.parse_parameter_ty_and_entrypoints ctxt ~legacy:false (Micheline.root parameters_ty) in - (* Check that the type is valid for rollups. *) - validate_parameters_ty ctxt arg_type + (* TODO: https://gitlab.com/tezos/tezos/-/issues/4023 + We currently don't support entrypoints as the entrypoint information + for L1 to L2 messages is not propagated to the rollup. *) + validate_parameters_ty ctxt arg_type entrypoint let check_origination_proof (type state proof output) ~(pvm : (state, proof, output) Sc_rollup.PVM.implementation) boot_sector @@ -199,7 +253,6 @@ let originate ctxt ~kind ~boot_sector ~origination_proof ~parameters_ty = in validate_untyped_parameters_ty ctxt parameters_ty in - let*? origination_proof = Sc_rollup.Proof.unserialize_pvm_step ~pvm origination_proof in @@ -225,11 +278,16 @@ let to_transaction_operation ctxt ~source (* Validate the type of the parameters. Only types that can be transferred from Layer 1 to Layer 2 are permitted. - In principal we could allow different types to be passed to the rollup and + In principle, we could allow different types to be passed to the rollup and from the rollup. In order to avoid confusion, and given that we don't have any use case where they differ, we keep these sets identical. + + We don't check whether the type contains any entrypoints at this stage. + It has already been done during origination. *) - let* ctxt = validate_parameters_ty ctxt parameters_ty in + let* ctxt = + validate_parameters_ty ctxt parameters_ty Script_typed_ir.no_entrypoints + in let operation = Script_typed_ir.Transaction_to_smart_contract { diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index 524c2b62c745ac567351ab2f8ecee86f43af7541..e8310d6b2830091e87babd62e9cd8902ae692011 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -38,7 +38,7 @@ open Script_typed_ir open Script_ir_translator open Local_gas_counter -type error += Rollup_invalid_transaction_amount +type error += Rollup_invalid_transaction_amount | Rollup_invalid_entrypoint let () = register_error_kind @@ -53,7 +53,19 @@ let () = Format.pp_print_string ppf "Transaction amount to a rollup must be zero.") Data_encoding.unit (function Rollup_invalid_transaction_amount -> Some () | _ -> None) - (fun () -> Rollup_invalid_transaction_amount) + (fun () -> Rollup_invalid_transaction_amount) ; + register_error_kind + `Permanent + ~id:"operation.rollup_invalid_entrypoint" + ~title:"Only the default entrypoint is allowed for rollups" + ~description:"Rollups only support transactions to the default entrypoint." + ~pp:(fun ppf () -> + Format.pp_print_string + ppf + "Rollups only support transactions to the default entrypoint.") + Data_encoding.unit + (function Rollup_invalid_entrypoint -> Some () | _ -> None) + (fun () -> Rollup_invalid_entrypoint) (* @@ -592,6 +604,11 @@ let make_transaction_to_sc_rollup ctxt ~destination ~amount ~entrypoint ~parameters_ty ~parameters = error_unless Tez.(amount = zero) Rollup_invalid_transaction_amount >>?= fun () -> + (* TODO: https://gitlab.com/tezos/tezos/-/issues/4023 + We currently don't support entrypoints as the entrypoint information + for L1 to L2 messages is not propagated to the rollup. *) + error_unless (Entrypoint.is_default entrypoint) Rollup_invalid_entrypoint + >>?= fun () -> unparse_data ctxt Optimized parameters_ty parameters >|=? fun (unparsed_parameters, ctxt) -> ( Transaction_to_sc_rollup diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml index f813f58e7085c8276aafd35b2c62f3af328db65a..27c9b786571dfa565af2104cc6f66a3b1737aca0 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml @@ -821,65 +821,6 @@ let test_parse_contract_data_for_unit_rollup () = in return () -(** Test [parse_contract_data] for rollup with entrypoints in type. *) -let test_parse_contract_data_for_rollup_with_entrypoints () = - let open Lwt_result_syntax in - let* block, (contract, _) = context_init_with_sc_rollup_enabled T2 in - let* block, rollup = - sc_originate block contract "or (pair %add nat nat) (unit %reset)" - in - let rollup_destination = Sc_rollup.Address.to_b58check rollup in - let* incr = Incremental.begin_construction block in - let ctxt = Incremental.alpha_ctxt incr in - let* ctxt, typed_contract = - let*? (Script_typed_ir.Ty_ex_c nat_pair) = - Environment.wrap_tzresult Script_typed_ir.(pair_t (-1) nat_t nat_t) - in - wrap_error_lwt - @@ Script_ir_translator.parse_contract_data - ctxt - (-1) - nat_pair - (Destination.Sc_rollup rollup) - ~entrypoint:(Entrypoint.of_string_strict_exn "add") - in - let destination = Script_typed_ir.Typed_contract.destination typed_contract in - let entrypoint = Script_typed_ir.Typed_contract.entrypoint typed_contract in - (* Check that the destinations match. *) - let* () = - Assert.equal_string - ~loc:__LOC__ - (Destination.to_b58check destination) - rollup_destination - in - (* Check that entrypoints match. *) - let* () = - Assert.equal_string ~loc:__LOC__ (Entrypoint.to_string entrypoint) "add" - in - let* _ctxt, typed_contract = - wrap_error_lwt - @@ Script_ir_translator.parse_contract_data - ctxt - (-1) - Script_typed_ir.unit_t - (Destination.Sc_rollup rollup) - ~entrypoint:(Entrypoint.of_string_strict_exn "reset") - in - let destination = Script_typed_ir.Typed_contract.destination typed_contract in - let entrypoint = Script_typed_ir.Typed_contract.entrypoint typed_contract in - (* Check that the destinations match. *) - let* () = - Assert.equal_string - ~loc:__LOC__ - (Destination.to_b58check destination) - rollup_destination - in - (* Check that entrypoints match. *) - let* () = - Assert.equal_string ~loc:__LOC__ (Entrypoint.to_string entrypoint) "reset" - in - return () - (** Test that [parse_contract_data] for rollup with invalid type fails. *) let test_parse_contract_data_for_rollup_with_invalid_type () = let open Lwt_result_syntax in @@ -971,11 +912,7 @@ let tests = `Quick test_parse_contract_data_for_unit_rollup; Tztest.tztest - "test parse contract data for rollup with entrypoint" - `Quick - test_parse_contract_data_for_rollup_with_entrypoints; - Tztest.tztest - "test parse contract data for rollup with entrypoint" + "test parse contract data for rollup with entrypoint invalid type" `Quick test_parse_contract_data_for_rollup_with_invalid_type; Tztest.tztest diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml index 5b500c07bf38d51061ae36234d9a5f11a836f5cc..2b91a57aa7dc9f3bccc9459bbe1e533857888430 100644 --- a/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml +++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml @@ -852,6 +852,7 @@ let test_originating_with_invalid_types () = "sapling_state 2"; "sapling_transaction 2"; "lambda string nat"; + "or (nat %deposit) (string %name)"; ] |> List.iter_es assert_fails_for_type in @@ -991,7 +992,6 @@ let test_originating_with_valid_type () = "or nat string"; "map string int"; "map (option (pair nat string)) (list (ticket nat))"; - "or (nat %deposit) (string %name)"; ] |> List.iter_es assert_parameters_ty @@ -2585,10 +2585,6 @@ let tests = "originating with valid type" `Quick test_originating_with_valid_type; - Tztest.tztest - "originating with invalid types" - `Quick - test_originating_with_invalid_types; Tztest.tztest "originating with invalid boot sector proof" `Quick @@ -2610,10 +2606,6 @@ let tests = binary tree" `Quick (test_originating_with_wrong_tree ~alter_binary_bit:true); - Tztest.tztest - "originating with valid type" - `Quick - test_originating_with_valid_type; Tztest.tztest "single transaction atomic batch" `Quick diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup_transfer.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup_transfer.ml index af0ba0c30d21e0c8af5ce11deaf88204a688f97d..9a160b03f62dcd0ebfea437725eb02fd280049b4 100644 --- a/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup_transfer.ml +++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup_transfer.ml @@ -264,12 +264,8 @@ let test_transfer_non_zero_amount () = (* Use the correct type through an entrypoint but with a non-zero amount. *) let test_transfer_non_zero_amount_via_entrypoint () = - let* b, c, contract, rollup = - context_init "or (int %use_this_one) (unit %not_that_one)" - in - let param = - Format.sprintf "%S" (Sc_rollup.Address.to_b58check rollup ^ "%use_this_one") - in + let* b, c, contract, rollup = context_init "int" in + let param = Format.sprintf "%S" (Sc_rollup.Address.to_b58check rollup) in let* (_b : Block.t) = transfer b