From f939d32b1c986e29c4a0ec094df6879942d12cf4 Mon Sep 17 00:00:00 2001 From: Valentin Chaboche Date: Mon, 5 Sep 2022 10:36:36 +0200 Subject: [PATCH 1/4] Scoru,Proto: use type annotation --- .../lib_protocol/sc_rollup_proof_repr.ml | 20 +++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) 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 f6313e7904f9..a3f4d00cb6a0 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml @@ -95,14 +95,16 @@ 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) | _ -> proof_error @@ -152,17 +154,19 @@ 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 -- GitLab From 376a95b4216a4a6042800e28f8f9179ca9c72d99 Mon Sep 17 00:00:00 2001 From: Valentin Chaboche Date: Mon, 5 Sep 2022 10:42:48 +0200 Subject: [PATCH 2/4] Scoru,Proto: exhaustive pattern --- src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 a3f4d00cb6a0..4048e7581bec 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml @@ -106,7 +106,7 @@ let valid snapshot commit_level ~pvm_name proof = check_inbox_proof snapshot inbox_proof (Raw_level_repr.root, Z.zero) | 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" -- GitLab From ec24b04fae6ff8aece6960a96b674d77d62b54ce Mon Sep 17 00:00:00 2001 From: Valentin Chaboche Date: Mon, 5 Sep 2022 11:28:42 +0200 Subject: [PATCH 3/4] Scoru,Proto: tzresult monad in [produce_proof] --- src/proto_alpha/lib_protocol/alpha_context.mli | 4 ++-- src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.ml | 3 +-- src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.mli | 3 +-- src/proto_alpha/lib_protocol/sc_rollup_arith.ml | 2 +- src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml | 9 +-------- src/proto_alpha/lib_protocol/sc_rollup_wasm.ml | 2 +- 6 files changed, 7 insertions(+), 16 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index b65cba0af6b0..4d06ff73ef6d 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -3213,7 +3213,7 @@ 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 @@ -3362,7 +3362,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 cc6a37cfacb6..6ee0112dbf31 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.ml @@ -176,8 +176,7 @@ 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 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 98fa6552ddd7..900f86a0060c 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]. *) diff --git a/src/proto_alpha/lib_protocol/sc_rollup_arith.ml b/src/proto_alpha/lib_protocol/sc_rollup_arith.ml index 36a9ea2d5fd6..100f66a97e13 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 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 4048e7581bec..3c7c9d315a98 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_proof_repr.ml @@ -145,11 +145,6 @@ 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 @@ -173,9 +168,7 @@ let produce pvm_and_state commit_level = 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 1c9f2227d598..b655aa35a978 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 -- GitLab From 73a768691da121eba37dd59b17e29ff42d7406ba Mon Sep 17 00:00:00 2001 From: Valentin Chaboche Date: Mon, 5 Sep 2022 11:33:49 +0200 Subject: [PATCH 4/4] Scoru,Proto: tzresult monad in [produce_origination_proof] --- src/proto_alpha/lib_protocol/alpha_context.mli | 3 +-- src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.ml | 3 +-- src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.mli | 3 +-- src/proto_alpha/lib_protocol/sc_rollup_arith.ml | 2 +- src/proto_alpha/lib_protocol/sc_rollup_wasm.ml | 2 +- 5 files changed, 5 insertions(+), 8 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 4d06ff73ef6d..bf43a1cd39bd 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -3217,8 +3217,7 @@ module Sc_rollup : sig 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.ml b/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.ml index 6ee0112dbf31..982f2b7ed54e 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.ml @@ -180,8 +180,7 @@ module type S = sig 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 900f86a0060c..2094109fc5c6 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.mli +++ b/src/proto_alpha/lib_protocol/sc_rollup_PVM_sem.mli @@ -249,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 100f66a97e13..7f9761f3525c 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_arith.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_arith.ml @@ -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_wasm.ml b/src/proto_alpha/lib_protocol/sc_rollup_wasm.ml index b655aa35a978..8fa410b9d742 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_wasm.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_wasm.ml @@ -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 -> -- GitLab