diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index b65cba0af6b0ddd6feafaeef767f63c8b762100c..bf43a1cd39bd0ba973abf25c3d4b4d41dd0b46d8 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -3213,12 +3213,11 @@ module Sc_rollup : sig val verify_proof : proof -> bool Lwt.t val produce_proof : - context -> input option -> state -> (proof, error) result Lwt.t + context -> input option -> state -> proof tzresult Lwt.t val verify_origination_proof : proof -> string -> bool Lwt.t - val produce_origination_proof : - context -> string -> (proof, error) result Lwt.t + val produce_origination_proof : context -> string -> proof tzresult Lwt.t type output_proof @@ -3362,7 +3361,7 @@ module Sc_rollup : sig val get_status : state -> status Lwt.t val produce_proof : - context -> input option -> state -> (proof, error) result Lwt.t + context -> input option -> state -> proof tzresult Lwt.t end module Protocol_implementation : diff --git a/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.ml b/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.ml index cc6a37cfacb6dbd07b361ba3f09b23bd87dd3962..982f2b7ed54e4ec57ab145f51a35df85354cc729 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.ml @@ -176,13 +176,11 @@ module type S = sig val verify_proof : proof -> bool Lwt.t - val produce_proof : - context -> input option -> state -> (proof, error) result Lwt.t + val produce_proof : context -> input option -> state -> proof tzresult Lwt.t val verify_origination_proof : proof -> string -> bool Lwt.t - val produce_origination_proof : - context -> string -> (proof, error) result Lwt.t + val produce_origination_proof : context -> string -> proof tzresult Lwt.t type output_proof diff --git a/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.mli b/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.mli index 98fa6552ddd71b15eead25c9b136b54685a13d38..2094109fc5c6a1c9af743d6da158685d674727fa 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.mli +++ b/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.mli @@ -239,8 +239,7 @@ module type S = sig - the [input_given] doesn't match the expectations of [state] ; - the [context] for this instance of the PVM doesn't have access to enough of the [state] to build the proof. *) - val produce_proof : - context -> input option -> state -> (proof, error) result Lwt.t + val produce_proof : context -> input option -> state -> proof tzresult Lwt.t (** [verify_origination_proof proof boot_sector] verifies a proof supposedly generated by [produce_origination_proof]. *) @@ -250,8 +249,7 @@ module type S = sig [p] covering the specialization of a PVM, from the [initial_state] up to the genesis state wherein the [boot_sector] has been installed. *) - val produce_origination_proof : - context -> string -> (proof, error) result Lwt.t + val produce_origination_proof : context -> string -> proof tzresult Lwt.t (** The following type is inhabited by the proofs that a given [output] is part of the outbox of a given [state]. *) diff --git a/src/proto_alpha/lib_protocol/sc_rollup_arith.ml b/src/proto_alpha/lib_protocol/sc_rollup_arith.ml index 36a9ea2d5fd6ad7276bb8d8c45e4d42e10753c0e..7f9761f3525c6c1bb8e17a53d6df09c611abfa55 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_arith.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_arith.ml @@ -1106,7 +1106,7 @@ module Make (Context : P) : type error += Arith_proof_production_failed let produce_proof context input_given state = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let*! result = Context.produce_proof context state (step_transition input_given) in @@ -1128,7 +1128,7 @@ module Make (Context : P) : match result with None -> return false | Some (_, ()) -> return true let produce_origination_proof context boot_sector = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let*! state = initial_state context in let*! result = Context.produce_proof context state (fun state -> diff --git a/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml b/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml index f6313e7904f9d1b395353f93fc8affe21c9a651c..3c7c9d315a9808335dc83db94ee0c17b739d934f 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml @@ -95,16 +95,18 @@ let valid snapshot commit_level ~pvm_name proof = let open Lwt_tzresult_syntax in let (module P) = Sc_rollups.wrapped_proof_module proof.pvm_step in let* () = check (String.equal P.name pvm_name) "Incorrect PVM kind" in - let input_requested = P.proof_input_requested P.proof in + let (input_requested : Sc_rollup_PVM_sem.input_request) = + P.proof_input_requested P.proof + in let input_given = P.proof_input_given P.proof in let* input = match (input_requested, proof.inbox) with - | Sc_rollup_PVM_sem.No_input_required, None -> return None - | Sc_rollup_PVM_sem.Initial, Some inbox_proof -> + | No_input_required, None -> return None + | Initial, Some inbox_proof -> check_inbox_proof snapshot inbox_proof (Raw_level_repr.root, Z.zero) - | Sc_rollup_PVM_sem.First_after (level, counter), Some inbox_proof -> + | First_after (level, counter), Some inbox_proof -> check_inbox_proof snapshot inbox_proof (level, Z.succ counter) - | _ -> + | No_input_required, Some _ | Initial, None | First_after _, None -> proof_error (Format.asprintf "input_requested is %a, inbox proof is %a" @@ -143,35 +145,30 @@ module type PVM_with_context_and_state = sig end end -let of_lwt_result result = - let open Lwt_tzresult_syntax in - let*! r = result in - match r with Ok x -> return x | Error e -> fail e - let produce pvm_and_state commit_level = let open Lwt_tzresult_syntax in let (module P : PVM_with_context_and_state) = pvm_and_state in let open P in - let*! request = P.is_input_state P.state in + let*! (request : Sc_rollup_PVM_sem.input_request) = + P.is_input_state P.state + in let* inbox, input_given = match request with - | Sc_rollup_PVM_sem.No_input_required -> return (None, None) - | Sc_rollup_PVM_sem.Initial -> + | No_input_required -> return (None, None) + | Initial -> let* p, i = Inbox_with_history.( produce_proof context history inbox (Raw_level_repr.root, Z.zero)) in return (Some (Inbox_with_history.to_serialized_proof p), i) - | Sc_rollup_PVM_sem.First_after (l, n) -> + | First_after (l, n) -> let* p, i = Inbox_with_history.(produce_proof context history inbox (l, Z.succ n)) in return (Some (Inbox_with_history.to_serialized_proof p), i) in let input_given = Option.bind input_given (cut_at_level commit_level) in - let* pvm_step_proof = - of_lwt_result (P.produce_proof P.context input_given P.state) - in + let* pvm_step_proof = P.produce_proof P.context input_given P.state in let module P_with_proof = struct include P diff --git a/src/proto_alpha/lib_protocol/sc_rollup_wasm.ml b/src/proto_alpha/lib_protocol/sc_rollup_wasm.ml index 1c9f2227d59866161ea1258362b61085e5d46baa..8fa410b9d742ba1cd6edcaf48bee97616b5a493d 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_wasm.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_wasm.ml @@ -331,7 +331,7 @@ module V2_0_0 = struct type error += WASM_proof_production_failed let produce_proof context input_given state = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let*! result = Context.produce_proof context state (step_transition input_given) in @@ -353,7 +353,7 @@ module V2_0_0 = struct match result with None -> return false | Some (_, ()) -> return true let produce_origination_proof context boot_sector = - let open Lwt_result_syntax in + let open Lwt_tzresult_syntax in let*! state = initial_state context in let*! result = Context.produce_proof context state (fun state ->