From 649df5b63d2757272228eb08473b4545ec823dd6 Mon Sep 17 00:00:00 2001
From: Sylvain Ribstein <sylvain.ribstein@gmail.com>
Date: Thu, 6 Jul 2023 14:23:39 +0200
Subject: [PATCH 1/9] proto/alpha: split execute_outbox_msg fct in two

---
 .../lib_protocol/sc_rollup_operations.ml      | 128 ++++++++++--------
 1 file changed, 71 insertions(+), 57 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
index 150f5177552d..fefee4734dbf 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
@@ -387,46 +387,8 @@ let validate_outbox_level ctxt ~outbox_level ~lcc_level =
     (Raw_level.(outbox_level <= lcc_level) && outbox_level_is_active)
     Sc_rollup_invalid_outbox_level
 
-let execute_outbox_message ctxt ~validate_and_decode_output_proof rollup
-    ~cemented_commitment ~output_proof =
+let execute_outbox_message_transaction ctxt ~transactions ~rollup =
   let open Lwt_result_syntax in
-  (* Get inbox level of last cemented commitment, needed to validate that the
-     outbox message is active. This call also implicitly checks that the rollup
-     exists. *)
-  let* lcc_hash, lcc_level, ctxt =
-    Sc_rollup.Commitment.last_cemented_commitment_hash_with_level ctxt rollup
-  in
-  (* Check that the commitment is a cemented commitment still stored in the
-     context. We start from the [lcc_hash] of the rollup, which we know to be
-     stored in context. *)
-  let* is_cemented_commitment_in_context, ctxt =
-    Sc_rollup.Commitment.check_if_commitments_are_related
-      ctxt
-      rollup
-      ~descendant:lcc_hash
-      ~ancestor:cemented_commitment
-  in
-  let* () =
-    fail_unless
-      is_cemented_commitment_in_context
-      Sc_rollup_invalid_last_cemented_commitment
-  in
-  (* Validate and decode the output proofs. *)
-  let* Sc_rollup.{outbox_level; message_index; message}, ctxt =
-    validate_and_decode_output_proof
-      ctxt
-      ~cemented_commitment
-      rollup
-      ~output_proof
-  in
-  (* Validate that the outbox level is within valid bounds. *)
-  let* () = validate_outbox_level ctxt ~outbox_level ~lcc_level in
-  let* ( Sc_rollup_management_protocol.Atomic_transaction_batch {transactions},
-         ctxt ) =
-    Sc_rollup_management_protocol.outbox_message_of_outbox_message_repr
-      ctxt
-      message
-  in
   (* Turn the transaction batch into a list of operations. *)
   let*? ctxt, operations =
     List.fold_left_map_e
@@ -437,23 +399,6 @@ let execute_outbox_message ctxt ~validate_and_decode_output_proof rollup
       ctxt
       transactions
   in
-  (* Record that the message for the given level has been applied. This fails
-     in case a message for the rollup, outbox-level and message index has
-     already been executed. The storage diff returned may be negative.
-  *)
-  let* applied_msg_size_diff, ctxt =
-    Sc_rollup.Outbox.record_applied_message
-      ctxt
-      rollup
-      outbox_level
-      ~message_index:(Z.to_int message_index)
-  in
-  (* TODO: #3121
-     Implement a more refined model. For instance a water-mark based one.
-     For now we only charge for positive contributions. It means that over time
-     we are overcharging for storage space.
-  *)
-  let paid_storage_size_diff = Z.max Z.zero applied_msg_size_diff in
   (* Extract the ticket-token diffs from the operations. We here make sure that
      there are no tickets with amount zero. Zero-amount tickets are not allowed
      as they cannot be tracked by the ticket-balance table.
@@ -478,7 +423,7 @@ let execute_outbox_message ctxt ~validate_and_decode_output_proof rollup
           ~source_destination
           ~acc_storage_diff
           ticket_token_diff)
-      (paid_storage_size_diff, ctxt)
+      (Z.zero, ctxt)
       ticket_token_diffs
   in
   let* ctxt, ticket_receipt =
@@ -509,6 +454,75 @@ let execute_outbox_message ctxt ~validate_and_decode_output_proof rollup
   in
   return ({paid_storage_size_diff; ticket_receipt; operations}, ctxt)
 
+let execute_outbox_message ctxt ~validate_and_decode_output_proof rollup
+    ~cemented_commitment ~output_proof =
+  let open Lwt_result_syntax in
+  (* Get inbox level of last cemented commitment, needed to validate that the
+     outbox message is active. This call also implicitly checks that the rollup
+     exists. *)
+  let* lcc_hash, lcc_level, ctxt =
+    Sc_rollup.Commitment.last_cemented_commitment_hash_with_level ctxt rollup
+  in
+  (* Check that the commitment is a cemented commitment still stored in the
+     context. We start from the [lcc_hash] of the rollup, which we know to be
+     stored in context. *)
+  let* is_cemented_commitment_in_context, ctxt =
+    Sc_rollup.Commitment.check_if_commitments_are_related
+      ctxt
+      rollup
+      ~descendant:lcc_hash
+      ~ancestor:cemented_commitment
+  in
+  let* () =
+    fail_unless
+      is_cemented_commitment_in_context
+      Sc_rollup_invalid_last_cemented_commitment
+  in
+  (* Validate and decode the output proofs. *)
+  let* Sc_rollup.{outbox_level; message_index; message}, ctxt =
+    validate_and_decode_output_proof
+      ctxt
+      ~cemented_commitment
+      rollup
+      ~output_proof
+  in
+  (* Validate that the outbox level is within valid bounds. *)
+  let* () = validate_outbox_level ctxt ~outbox_level ~lcc_level in
+  let* decoded_outbox_msg, ctxt =
+    Sc_rollup_management_protocol.outbox_message_of_outbox_message_repr
+      ctxt
+      message
+  in
+  let* receipt, ctxt =
+    match decoded_outbox_msg with
+    | Sc_rollup_management_protocol.Atomic_transaction_batch {transactions} ->
+        execute_outbox_message_transaction ctxt ~transactions ~rollup
+  in
+  (* Record that the message for the given level has been applied. This fails
+     in case a message for the rollup, outbox-level and message index has
+     already been executed. The storage diff returned may be negative.
+  *)
+  let* applied_msg_size_diff, ctxt =
+    Sc_rollup.Outbox.record_applied_message
+      ctxt
+      rollup
+      outbox_level
+      ~message_index:(Z.to_int message_index)
+  in
+  (* TODO: https://gitlab.com/tezos/tezos/-/issues/3121
+     Implement a more refined model. For instance a water-mark based one.
+     For now we only charge for positive contributions. It means that over time
+     we are overcharging for storage space.
+  *)
+  let applied_msg_size_diff = Z.max Z.zero applied_msg_size_diff in
+  return
+    ( {
+        receipt with
+        paid_storage_size_diff =
+          Z.add receipt.paid_storage_size_diff applied_msg_size_diff;
+      },
+      ctxt )
+
 module Internal_for_tests = struct
   let execute_outbox_message = execute_outbox_message
 end
-- 
GitLab


From c8a736041264a48e5cbf7a7e4cfb79ac3d566c34 Mon Sep 17 00:00:00 2001
From: Sylvain Ribstein <sylvain.ribstein@gmail.com>
Date: Thu, 6 Jul 2023 15:16:31 +0200
Subject: [PATCH 2/9] proto/soru: add whitelist update outbox msg

---
 .../lib_protocol/alpha_context.mli            |  1 +
 .../sc_rollup_management_protocol.ml          | 26 +++++++++++-------
 .../sc_rollup_management_protocol.mli         | 17 ++++++------
 .../lib_protocol/sc_rollup_operations.ml      | 11 ++++++++
 .../sc_rollup_outbox_message_repr.ml          | 13 +++++++++
 .../sc_rollup_outbox_message_repr.mli         |  1 +
 .../lib_protocol/sc_rollup_whitelist_repr.ml  |  5 +++-
 .../test_sc_rollup_management_protocol.ml     | 27 ++++++++++---------
 8 files changed, 70 insertions(+), 31 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index fa1aa5c57997..5075a0ea2e20 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -3170,6 +3170,7 @@ module Sc_rollup : sig
         | Atomic_transaction_batch_typed of {
             transactions : typed_transaction list;
           }
+        | Whitelist_update of Whitelist.t option
 
       val pp : Format.formatter -> t -> unit
 
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml
index 0c260b77a9da..3bd0d7b13667 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml
@@ -52,7 +52,9 @@ type transaction =
 
 type atomic_transaction_batch = {transactions : transaction list}
 
-type outbox_message = Atomic_transaction_batch of atomic_transaction_batch
+type outbox_message =
+  | Atomic_transaction_batch of atomic_transaction_batch
+  | Whitelist_update of Sc_rollup.Whitelist.t option
 
 let make_internal_transfer ctxt ty ~payload ~sender ~source ~destination =
   let open Lwt_result_syntax in
@@ -133,14 +135,19 @@ let internal_typed_transaction ctxt
 
 let outbox_message_of_outbox_message_repr ctxt transactions =
   let open Lwt_result_syntax in
-  let* ctxt, transactions =
-    match transactions with
-    | Sc_rollup.Outbox.Message.Atomic_transaction_batch {transactions} ->
+  match transactions with
+  | Sc_rollup.Outbox.Message.Atomic_transaction_batch {transactions} ->
+      let* ctxt, transactions =
         List.fold_left_map_es internal_untyped_transaction ctxt transactions
-    | Sc_rollup.Outbox.Message.Atomic_transaction_batch_typed {transactions} ->
+      in
+      return (Atomic_transaction_batch {transactions}, ctxt)
+  | Sc_rollup.Outbox.Message.Atomic_transaction_batch_typed {transactions} ->
+      let* ctxt, transactions =
         List.fold_left_map_es internal_typed_transaction ctxt transactions
-  in
-  return (Atomic_transaction_batch {transactions}, ctxt)
+      in
+      return (Atomic_transaction_batch {transactions}, ctxt)
+  | Sc_rollup.Outbox.Message.Whitelist_update whitelist_opt ->
+      return (Whitelist_update whitelist_opt, ctxt)
 
 module Internal_for_tests = struct
   let make_transaction ctxt parameters_ty ~parameters ~destination ~entrypoint =
@@ -161,8 +168,7 @@ module Internal_for_tests = struct
 
   let make_atomic_batch transactions = Atomic_transaction_batch {transactions}
 
-  let serialize_outbox_message_untyped (Atomic_transaction_batch {transactions})
-      =
+  let serialize_outbox_transactions_untyped transactions =
     let open Result_syntax in
     let of_internal_transaction
         (Transaction
@@ -182,7 +188,7 @@ module Internal_for_tests = struct
     in
     Sc_rollup.Outbox.Message.serialize output_message_internal
 
-  let serialize_outbox_message_typed (Atomic_transaction_batch {transactions}) =
+  let serialize_outbox_transactions_typed transactions =
     let open Result_syntax in
     let of_internal_transaction
         (Transaction
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.mli b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.mli
index 0b2d7c69aff9..9b13c2d6db24 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.mli
+++ b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.mli
@@ -59,6 +59,7 @@ type atomic_transaction_batch = private {transactions : transaction list}
 (** A typed representation of {!Sc_rollup.Outbox.Message.t}. *)
 type outbox_message = private
   | Atomic_transaction_batch of atomic_transaction_batch
+  | Whitelist_update of Sc_rollup.Whitelist.t option
 
 (** [make_internal_transfer ctxt ty ~payload ~sender ~source ~destination]
     constructs a smart rollup's [inbox message] (an L1 to L2 message)
@@ -101,17 +102,17 @@ module Internal_for_tests : sig
       transactions [ts]. *)
   val make_atomic_batch : transaction list -> outbox_message
 
-  (** [serialize_output_message_untyped msg] encodes the outbox message
-      [msg] in binary format using the untyped outbox message
+  (** [serialize_output_transactions_untyped t] encodes the outbox transaction
+      batch [t] in binary format using the untyped outbox message
       representation. *)
-  val serialize_outbox_message_untyped :
-    outbox_message -> Sc_rollup.Outbox.Message.serialized tzresult
+  val serialize_outbox_transactions_untyped :
+    transaction list -> Sc_rollup.Outbox.Message.serialized tzresult
 
-  (** [serialize_output_message_typed msg] encodes the outbox
-      message [msg] in binary format using the typed outbox message
+  (** [serialize_output_transactions_typed t] encodes the outbox
+      transaction batch [t] in binary format using the typed outbox message
       representation. *)
-  val serialize_outbox_message_typed :
-    outbox_message -> Sc_rollup.Outbox.Message.serialized tzresult
+  val serialize_outbox_transactions_typed :
+    transaction list -> Sc_rollup.Outbox.Message.serialized tzresult
 
   (** [deserialize_inbox_message bs] decodes an inbox message from the given data
       [bs]. *)
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
index fefee4734dbf..d48a5a4411d3 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
@@ -497,6 +497,17 @@ let execute_outbox_message ctxt ~validate_and_decode_output_proof rollup
     match decoded_outbox_msg with
     | Sc_rollup_management_protocol.Atomic_transaction_batch {transactions} ->
         execute_outbox_message_transaction ctxt ~transactions ~rollup
+    | Sc_rollup_management_protocol.Whitelist_update _whitelist_opt ->
+        let is_enabled = Constants.sc_rollup_private_enable ctxt in
+        if is_enabled then
+          return
+            ( {
+                paid_storage_size_diff = Z.zero;
+                ticket_receipt = [];
+                operations = [];
+              },
+              ctxt )
+        else tzfail Sc_rollup_errors.Sc_rollup_whitelist_disabled
   in
   (* Record that the message for the given level has been applied. This fails
      in case a message for the rollup, outbox-level and message index has
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_outbox_message_repr.ml b/src/proto_alpha/lib_protocol/sc_rollup_outbox_message_repr.ml
index 9c2bdeafd8c8..b9fbb8c60958 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_outbox_message_repr.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_outbox_message_repr.ml
@@ -132,6 +132,7 @@ let pp_typed_transaction fmt
 type t =
   | Atomic_transaction_batch of {transactions : transaction list}
   | Atomic_transaction_batch_typed of {transactions : typed_transaction list}
+  | Whitelist_update of Sc_rollup_whitelist_repr.t option
 
 let encoding =
   let open Data_encoding in
@@ -166,6 +167,16 @@ let encoding =
              | _ -> None)
            (fun (transactions, ()) ->
              Atomic_transaction_batch_typed {transactions});
+         case
+           (Tag 2)
+           ~title:"Whitelist_update"
+           (obj2
+              (opt "whitelist" Sc_rollup_whitelist_repr.encoding)
+              (req "kind" (constant "whitelist_update")))
+           (function
+             | Whitelist_update whitelist_opt -> Some (whitelist_opt, ())
+             | _ -> None)
+           (fun (whitelist_opt, ()) -> Whitelist_update whitelist_opt);
        ])
 
 let pp fmt = function
@@ -181,6 +192,8 @@ let pp fmt = function
         pp_typed_transaction
         fmt
         transactions
+  | Whitelist_update whitelist_opt ->
+      Format.pp_print_option Sc_rollup_whitelist_repr.pp fmt whitelist_opt
 
 type serialized = string
 
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_outbox_message_repr.mli b/src/proto_alpha/lib_protocol/sc_rollup_outbox_message_repr.mli
index 8c6be75895cd..166cec0bfc9a 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_outbox_message_repr.mli
+++ b/src/proto_alpha/lib_protocol/sc_rollup_outbox_message_repr.mli
@@ -54,6 +54,7 @@ type typed_transaction = {
 type t =
   | Atomic_transaction_batch of {transactions : transaction list}
   | Atomic_transaction_batch_typed of {transactions : typed_transaction list}
+  | Whitelist_update of Sc_rollup_whitelist_repr.t option
 
 val encoding : t Data_encoding.t
 
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_repr.ml b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_repr.ml
index 6039a805a1af..8953e35549ec 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_repr.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_repr.ml
@@ -27,4 +27,7 @@ type t = Signature.Public_key_hash.t list
 
 let encoding = Data_encoding.(list Signature.Public_key_hash.encoding)
 
-let pp = Format.pp_print_list Signature.Public_key_hash.pp
+let pp =
+  Format.pp_print_list
+    ~pp_sep:Format.pp_print_space
+    Signature.Public_key_hash.pp_short
diff --git a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_management_protocol.ml b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_management_protocol.ml
index e8af9186b77a..68943e4aeba9 100644
--- a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_management_protocol.ml
+++ b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_management_protocol.ml
@@ -52,12 +52,12 @@ let check_encode_decode_inbox_message message =
     (Sc_rollup.Inbox_message.unsafe_to_string bytes)
     (Sc_rollup.Inbox_message.unsafe_to_string bytes')
 
-let check_encode_decode_outbox_message_untyped ctxt message =
+let check_encode_decode_outbox_message_untyped ctxt transactions =
   let open Lwt_result_wrap_syntax in
   let open Sc_rollup_management_protocol in
   let*? bytes =
     Environment.wrap_tzresult
-    @@ Internal_for_tests.serialize_outbox_message_untyped message
+    @@ Internal_for_tests.serialize_outbox_transactions_untyped transactions
   in
   let* message', _ctxt =
     let*? message_repr =
@@ -66,20 +66,23 @@ let check_encode_decode_outbox_message_untyped ctxt message =
     wrap @@ outbox_message_of_outbox_message_repr ctxt message_repr
   in
   let*? bytes' =
-    Environment.wrap_tzresult
-    @@ Internal_for_tests.serialize_outbox_message_untyped message'
+    match message' with
+    | Whitelist_update _ -> assert false (* its serialized transaction *)
+    | Atomic_transaction_batch {transactions} ->
+        Environment.wrap_tzresult
+        @@ Internal_for_tests.serialize_outbox_transactions_untyped transactions
   in
   Assert.equal_string
     ~loc:__LOC__
     (Sc_rollup.Outbox.Message.unsafe_to_string bytes)
     (Sc_rollup.Outbox.Message.unsafe_to_string bytes')
 
-let check_encode_decode_outbox_message_typed ctxt message =
+let check_encode_decode_outbox_message_typed ctxt transactions =
   let open Lwt_result_wrap_syntax in
   let open Sc_rollup_management_protocol in
   let*? bytes =
     Environment.wrap_tzresult
-    @@ Internal_for_tests.serialize_outbox_message_typed message
+    @@ Internal_for_tests.serialize_outbox_transactions_typed transactions
   in
   let* message', _ctxt =
     let*? message_repr =
@@ -88,8 +91,11 @@ let check_encode_decode_outbox_message_typed ctxt message =
     wrap @@ outbox_message_of_outbox_message_repr ctxt message_repr
   in
   let*? bytes' =
-    Environment.wrap_tzresult
-    @@ Internal_for_tests.serialize_outbox_message_typed message'
+    match message' with
+    | Whitelist_update _ -> assert false (* its serialized transaction *)
+    | Atomic_transaction_batch {transactions} ->
+        Environment.wrap_tzresult
+        @@ Internal_for_tests.serialize_outbox_transactions_typed transactions
   in
   Assert.equal_string
     ~loc:__LOC__
@@ -326,10 +332,7 @@ let test_encode_decode_outbox_message () =
       ~destination:add_or_clear_destination
       ~entrypoint:(Entrypoint.of_string_strict_exn "clear")
   in
-  let outbox_message =
-    Sc_rollup_management_protocol.Internal_for_tests.make_atomic_batch
-      [transaction1; transaction2; transaction3]
-  in
+  let outbox_message = [transaction1; transaction2; transaction3] in
   let* () = check_encode_decode_outbox_message_untyped ctxt outbox_message in
   check_encode_decode_outbox_message_typed ctxt outbox_message
 
-- 
GitLab


From d3f607f982911e03d160f2e7c237686f73406ed8 Mon Sep 17 00:00:00 2001
From: Sylvain Ribstein <sylvain.ribstein@gmail.com>
Date: Tue, 1 Aug 2023 16:50:55 +0200
Subject: [PATCH 3/9] proto/soru: Whitelist.init return size in Z

---
 .../lib_protocol/alpha_context.mli            |  2 +-
 .../lib_protocol/sc_rollup_storage.ml         | 12 +++++----
 .../sc_rollup_whitelist_storage.ml            | 27 ++++++++++---------
 .../sc_rollup_whitelist_storage.mli           |  2 +-
 4 files changed, 24 insertions(+), 19 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 5075a0ea2e20..873ee30183d1 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2789,7 +2789,7 @@ module Sc_rollup : sig
     type t = public_key_hash list
 
     val init :
-      context -> Address.t -> whitelist:t -> (context * int) tzresult Lwt.t
+      context -> Address.t -> whitelist:t -> (context * Z.t) tzresult Lwt.t
 
     val find_whitelist_uncarbonated :
       context -> Address.t -> t option tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_storage.ml b/src/proto_alpha/lib_protocol/sc_rollup_storage.ml
index 6ad3b5e61511..72efe16766b1 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_storage.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_storage.ml
@@ -151,13 +151,15 @@ let raw_originate ?whitelist ctxt ~kind ~parameters_ty ~genesis_commitment
     let*? () = check_whitelist ctxt whitelist in
     match whitelist with
     | Some whitelist -> Sc_rollup_whitelist_storage.init ~whitelist ctxt address
-    | None -> return (ctxt, 0)
+    | None -> return (ctxt, Z.zero)
   in
   let size =
-    Z.of_int
-      (origination_size + stored_kind_size + addresses_size + param_ty_size
-     + pvm_kind_size + genesis_info_size_diff + commitment_size_diff
-     + whitelist_size)
+    Z.(
+      add
+        (of_int
+           (origination_size + stored_kind_size + addresses_size + param_ty_size
+          + pvm_kind_size + genesis_info_size_diff + commitment_size_diff))
+        whitelist_size)
   in
   return (size, genesis_info.commitment_hash, ctxt)
 
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
index 0afa34c43e62..eb44ae7b9966 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
@@ -32,18 +32,21 @@ let is_private ctxt rollup =
 
 let init ctxt rollup_address ~whitelist =
   let open Lwt_result_syntax in
-  List.fold_left_es
-    (fun (ctxt, size) e ->
-      let* ctxt, size_e =
-        (* the storage fails when there key already exists. This is
-           only to improve the UX so that it returns a cleaner
-           error. *)
-        trace Sc_rollup_errors.Sc_rollup_duplicated_key_in_whitelist
-        @@ Storage.Sc_rollup.Whitelist.init (ctxt, rollup_address) e
-      in
-      return (ctxt, size + size_e))
-    (ctxt, 0)
-    whitelist
+  let* ctxt, used_storage =
+    List.fold_left_es
+      (fun (ctxt, size) e ->
+        let* ctxt, size_e =
+          (* the storage fails when there key already exists. This is
+             only to improve the UX so that it returns a cleaner
+             error. *)
+          trace Sc_rollup_errors.Sc_rollup_duplicated_key_in_whitelist
+          @@ Storage.Sc_rollup.Whitelist.init (ctxt, rollup_address) e
+        in
+        return (ctxt, Z.add size (Z.of_int size_e)))
+      (ctxt, Z.zero)
+      whitelist
+  in
+  return (ctxt, used_storage)
 
 let check_access_to_private_rollup ctxt rollup staker =
   let open Lwt_result_syntax in
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
index 3dba27fa186f..90e8f87bbd51 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
+++ b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
@@ -36,7 +36,7 @@ val init :
   Raw_context.t ->
   Sc_rollup_repr.t ->
   whitelist:Sc_rollup_whitelist_repr.t ->
-  (Raw_context.t * int) tzresult Lwt.t
+  (Raw_context.t * Z.t) tzresult Lwt.t
 
 (** [check_access_to_private_rollup context rollup staker_pkh] returns an error
     if [staker_pkh] is not in the whitelist of [rollup] if the [rollup] is marked
-- 
GitLab


From 147a71c09b63a8fb589e3562e3467b1e0ade3d9c Mon Sep 17 00:00:00 2001
From: Sylvain Ribstein <sylvain.ribstein@gmail.com>
Date: Mon, 7 Aug 2023 17:31:33 +0200
Subject: [PATCH 4/9] proto/soru: whitelist update replace existing list

---
 .../lib_protocol/alpha_context.mli            |  5 +++
 .../lib_protocol/sc_rollup_errors.ml          | 15 ++++++-
 .../lib_protocol/sc_rollup_operations.ml      | 44 +++++++++++++++----
 .../sc_rollup_whitelist_storage.ml            |  5 +++
 .../sc_rollup_whitelist_storage.mli           |  9 ++++
 5 files changed, 69 insertions(+), 9 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 873ee30183d1..1fd5c41dacdb 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2791,9 +2791,14 @@ module Sc_rollup : sig
     val init :
       context -> Address.t -> whitelist:t -> (context * Z.t) tzresult Lwt.t
 
+    val is_private : context -> Address.t -> (context * bool) tzresult Lwt.t
+
     val find_whitelist_uncarbonated :
       context -> Address.t -> t option tzresult Lwt.t
 
+    val replace :
+      context -> Address.t -> whitelist:t -> (context * Z.t) tzresult Lwt.t
+
     val encoding : t Data_encoding.t
 
     val pp : Format.formatter -> t -> unit
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_errors.ml b/src/proto_alpha/lib_protocol/sc_rollup_errors.ml
index 1e3da00a1edd..93f7fbdc638f 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_errors.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_errors.ml
@@ -103,6 +103,7 @@ type error +=
   | Sc_rollup_whitelist_disabled
   | Sc_rollup_staker_not_in_whitelist
   | Sc_rollup_duplicated_key_in_whitelist
+  | Sc_rollup_is_public
 
 let () =
   register_error_kind
@@ -743,4 +744,16 @@ let () =
          keys in the whitelist should be disctinct.")
     Data_encoding.empty
     (function Sc_rollup_duplicated_key_in_whitelist -> Some () | _ -> None)
-    (fun () -> Sc_rollup_duplicated_key_in_whitelist)
+    (fun () -> Sc_rollup_duplicated_key_in_whitelist) ;
+  register_error_kind
+    `Permanent
+    ~id:"smart_rollup_rollup_is_public"
+    ~title:description
+    ~description
+    ~pp:(fun ppf () ->
+      Format.pp_print_string
+        ppf
+        "The rollup is public, no update whitelist message can be executed.")
+    Data_encoding.empty
+    (function Sc_rollup_is_public -> Some () | _ -> None)
+    (fun () -> Sc_rollup_is_public)
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
index d48a5a4411d3..e995629c7e9b 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
@@ -454,6 +454,40 @@ let execute_outbox_message_transaction ctxt ~transactions ~rollup =
   in
   return ({paid_storage_size_diff; ticket_receipt; operations}, ctxt)
 
+let execute_outbox_message_whitelist_update (ctxt : t) ~rollup ~whitelist =
+  let open Lwt_result_syntax in
+  let* ctxt, is_private = Sc_rollup.Whitelist.is_private ctxt rollup in
+  if is_private then
+    match whitelist with
+    | Some whitelist ->
+        (* The whitelist update fails with an empty list. *)
+        let*? () =
+          error_when
+            (List.is_empty whitelist)
+            Sc_rollup_errors.Sc_rollup_empty_whitelist
+        in
+        let* ctxt, _new_storage_size =
+          Sc_rollup.Whitelist.replace ctxt rollup ~whitelist
+        in
+        (* Storage size paid diff logic in next commit *)
+        return
+          ( {
+              paid_storage_size_diff = Z.zero;
+              ticket_receipt = [];
+              operations = [];
+            },
+            ctxt )
+    | None ->
+        (* logic implemented in a later commit *)
+        return
+          ( {
+              paid_storage_size_diff = Z.zero;
+              ticket_receipt = [];
+              operations = [];
+            },
+            ctxt )
+  else tzfail Sc_rollup_errors.Sc_rollup_is_public
+
 let execute_outbox_message ctxt ~validate_and_decode_output_proof rollup
     ~cemented_commitment ~output_proof =
   let open Lwt_result_syntax in
@@ -497,16 +531,10 @@ let execute_outbox_message ctxt ~validate_and_decode_output_proof rollup
     match decoded_outbox_msg with
     | Sc_rollup_management_protocol.Atomic_transaction_batch {transactions} ->
         execute_outbox_message_transaction ctxt ~transactions ~rollup
-    | Sc_rollup_management_protocol.Whitelist_update _whitelist_opt ->
+    | Sc_rollup_management_protocol.Whitelist_update whitelist ->
         let is_enabled = Constants.sc_rollup_private_enable ctxt in
         if is_enabled then
-          return
-            ( {
-                paid_storage_size_diff = Z.zero;
-                ticket_receipt = [];
-                operations = [];
-              },
-              ctxt )
+          execute_outbox_message_whitelist_update ctxt ~rollup ~whitelist
         else tzfail Sc_rollup_errors.Sc_rollup_whitelist_disabled
   in
   (* Record that the message for the given level has been applied. This fails
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
index eb44ae7b9966..2f189000dc20 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
@@ -76,3 +76,8 @@ let find_whitelist_uncarbonated ctxt rollup_address =
     in
     return (Some elts)
   else return None
+
+let replace ctxt rollup ~whitelist =
+  let open Lwt_result_syntax in
+  let* ctxt = Storage.Sc_rollup.Whitelist.clear (ctxt, rollup) in
+  init ~whitelist ctxt rollup
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
index 90e8f87bbd51..e8c558d7cd50 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
+++ b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
@@ -53,3 +53,12 @@ val find_whitelist_uncarbonated :
   Raw_context.t ->
   Sc_rollup_repr.t ->
   Signature.public_key_hash list option tzresult Lwt.t
+
+(** [replace context rollup ~whitelist] replaces the whitelist of
+    [rollup] in the storage by [whitelist]. Returns the resulting
+    context along with the used storage space. *)
+val replace :
+  Raw_context.t ->
+  Sc_rollup_repr.t ->
+  whitelist:Sc_rollup_whitelist_repr.t ->
+  (Raw_context.t * Z.t) tzresult Lwt.t
-- 
GitLab


From 99ad15a99db362e4729fdc3c6b49018fe2ac1c63 Mon Sep 17 00:00:00 2001
From: Sylvain Ribstein <sylvain.ribstein@gmail.com>
Date: Tue, 1 Aug 2023 16:53:50 +0200
Subject: [PATCH 5/9] proto/soru: burn fee for whitelist storage

---
 .../lib_protocol/alpha_context.mli            |  6 ++++
 .../lib_protocol/sc_rollup_operations.ml      | 13 ++++----
 .../lib_protocol/sc_rollup_storage.ml         |  9 +++++-
 .../sc_rollup_whitelist_storage.ml            | 30 +++++++++++++++++++
 .../sc_rollup_whitelist_storage.mli           | 15 ++++++++++
 src/proto_alpha/lib_protocol/storage.ml       | 16 ++++++++++
 src/proto_alpha/lib_protocol/storage.mli      | 14 +++++++++
 7 files changed, 94 insertions(+), 9 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 1fd5c41dacdb..c8cf0236189b 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2799,6 +2799,12 @@ module Sc_rollup : sig
     val replace :
       context -> Address.t -> whitelist:t -> (context * Z.t) tzresult Lwt.t
 
+    val adjust_storage_space :
+      context ->
+      Address.t ->
+      new_storage_size:Z.t ->
+      (context * Z.t) tzresult Lwt.t
+
     val encoding : t Data_encoding.t
 
     val pp : Format.formatter -> t -> unit
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
index e995629c7e9b..1096707bd294 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
@@ -466,17 +466,14 @@ let execute_outbox_message_whitelist_update (ctxt : t) ~rollup ~whitelist =
             (List.is_empty whitelist)
             Sc_rollup_errors.Sc_rollup_empty_whitelist
         in
-        let* ctxt, _new_storage_size =
+        let* ctxt, new_storage_size =
           Sc_rollup.Whitelist.replace ctxt rollup ~whitelist
         in
-        (* Storage size paid diff logic in next commit *)
+        let* ctxt, paid_storage_size_diff =
+          Sc_rollup.Whitelist.adjust_storage_space ctxt rollup ~new_storage_size
+        in
         return
-          ( {
-              paid_storage_size_diff = Z.zero;
-              ticket_receipt = [];
-              operations = [];
-            },
-            ctxt )
+          ({paid_storage_size_diff; ticket_receipt = []; operations = []}, ctxt)
     | None ->
         (* logic implemented in a later commit *)
         return
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_storage.ml b/src/proto_alpha/lib_protocol/sc_rollup_storage.ml
index 72efe16766b1..cfe5dc5862c6 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_storage.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_storage.ml
@@ -150,7 +150,14 @@ let raw_originate ?whitelist ctxt ~kind ~parameters_ty ~genesis_commitment
   let* ctxt, whitelist_size =
     let*? () = check_whitelist ctxt whitelist in
     match whitelist with
-    | Some whitelist -> Sc_rollup_whitelist_storage.init ~whitelist ctxt address
+    | Some whitelist ->
+        let* ctxt, new_storage_size =
+          Sc_rollup_whitelist_storage.init ~whitelist ctxt address
+        in
+        Sc_rollup_whitelist_storage.adjust_storage_space
+          ctxt
+          address
+          ~new_storage_size
     | None -> return (ctxt, Z.zero)
   in
   let size =
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
index 2f189000dc20..b040dda3296c 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
@@ -81,3 +81,33 @@ let replace ctxt rollup ~whitelist =
   let open Lwt_result_syntax in
   let* ctxt = Storage.Sc_rollup.Whitelist.clear (ctxt, rollup) in
   init ~whitelist ctxt rollup
+
+let adjust_storage_space ctxt rollup ~new_storage_size =
+  let open Lwt_result_syntax in
+  let* used_storage =
+    Storage.Sc_rollup.Whitelist_used_storage_space.find ctxt rollup
+  in
+  let used_storage = Option.value ~default:Z.zero used_storage in
+  let storage_diff = Z.sub new_storage_size used_storage in
+  if Compare.Z.(storage_diff = Z.zero) then return (ctxt, Z.zero)
+  else
+    let*! ctxt =
+      Storage.Sc_rollup.Whitelist_used_storage_space.add
+        ctxt
+        rollup
+        new_storage_size
+    in
+    let* paid_storage =
+      Storage.Sc_rollup.Whitelist_paid_storage_space.find ctxt rollup
+    in
+    let paid_storage = Option.value ~default:Z.zero paid_storage in
+    let diff = Z.sub new_storage_size paid_storage in
+    if Compare.Z.(Z.zero < diff) then
+      let*! ctxt =
+        Storage.Sc_rollup.Whitelist_paid_storage_space.add
+          ctxt
+          rollup
+          new_storage_size
+      in
+      return (ctxt, diff)
+    else return (ctxt, Z.zero)
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
index e8c558d7cd50..c29b21d58104 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
+++ b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
@@ -62,3 +62,18 @@ val replace :
   Sc_rollup_repr.t ->
   whitelist:Sc_rollup_whitelist_repr.t ->
   (Raw_context.t * Z.t) tzresult Lwt.t
+
+(** [adjust_storage_space ctxt ~new_storage_size] updates the used
+    storage space for the whitelist according to
+    [new_storage_size]. The additional positive amount of unpaid
+    storage is returned. If no unpaid storage is consumed, this amount
+    is 0.
+
+    Note that when storage space for the whitelist is released we may later
+    use that space for free. For this reason, the amount returned may be less
+    than the given (positive) [storage_diff]. *)
+val adjust_storage_space :
+  Raw_context.t ->
+  Sc_rollup_repr.t ->
+  new_storage_size:Z.t ->
+  (Raw_context.t * Z.t) tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml
index 6a47675c8130..09b389cdc3c1 100644
--- a/src/proto_alpha/lib_protocol/storage.ml
+++ b/src/proto_alpha/lib_protocol/storage.ml
@@ -2123,6 +2123,22 @@ module Sc_rollup = struct
            let name = ["whitelist"]
          end))
          (Public_key_hash_index)
+
+  module Whitelist_paid_storage_space =
+    Indexed_context.Make_map
+      (Registered)
+      (struct
+        let name = ["whitelist_paid_bytes"]
+      end)
+      (Encoding.Z)
+
+  module Whitelist_used_storage_space =
+    Indexed_context.Make_map
+      (Registered)
+      (struct
+        let name = ["whitelist_use_bytes"]
+      end)
+      (Encoding.Z)
 end
 
 module Dal = struct
diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli
index e35eab8ecd77..5e0fce18c3f2 100644
--- a/src/proto_alpha/lib_protocol/storage.mli
+++ b/src/proto_alpha/lib_protocol/storage.mli
@@ -1007,6 +1007,20 @@ module Sc_rollup : sig
     Carbonated_data_set_storage
       with type t := Raw_context.t * Sc_rollup_repr.t
        and type elt = Signature.Public_key_hash.t
+
+  (** Maximal space available for the whitelist without needing to burn new fees. *)
+  module Whitelist_paid_storage_space :
+    Indexed_data_storage
+      with type key = Sc_rollup_repr.t
+       and type value = Z.t
+       and type t = Raw_context.t
+
+  (** Current storage space in bytes used by the whitelist. *)
+  module Whitelist_used_storage_space :
+    Indexed_data_storage
+      with type t = Raw_context.t
+       and type key = Sc_rollup_repr.t
+       and type value = Z.t
 end
 
 module Dal : sig
-- 
GitLab


From ec2e68bdd75191d6be5f4cab17828895a4e74f46 Mon Sep 17 00:00:00 2001
From: Sylvain Ribstein <sylvain.ribstein@gmail.com>
Date: Tue, 1 Aug 2023 14:21:00 +0200
Subject: [PATCH 6/9] proto/soru: update whitelist with None makes rollup
 public

---
 src/proto_alpha/lib_protocol/alpha_context.mli       |  2 ++
 src/proto_alpha/lib_protocol/sc_rollup_operations.ml |  2 +-
 .../lib_protocol/sc_rollup_whitelist_storage.ml      | 12 ++++++++++++
 .../lib_protocol/sc_rollup_whitelist_storage.mli     |  6 ++++++
 4 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index c8cf0236189b..67ff28a63ccb 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2799,6 +2799,8 @@ module Sc_rollup : sig
     val replace :
       context -> Address.t -> whitelist:t -> (context * Z.t) tzresult Lwt.t
 
+    val make_public : context -> Address.t -> (context * Z.t) tzresult Lwt.t
+
     val adjust_storage_space :
       context ->
       Address.t ->
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
index 1096707bd294..037a07404e3c 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
@@ -475,7 +475,7 @@ let execute_outbox_message_whitelist_update (ctxt : t) ~rollup ~whitelist =
         return
           ({paid_storage_size_diff; ticket_receipt = []; operations = []}, ctxt)
     | None ->
-        (* logic implemented in a later commit *)
+        let* ctxt, _freed_size = Sc_rollup.Whitelist.make_public ctxt rollup in
         return
           ( {
               paid_storage_size_diff = Z.zero;
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
index b040dda3296c..c6d1efc9be3a 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.ml
@@ -82,6 +82,18 @@ let replace ctxt rollup ~whitelist =
   let* ctxt = Storage.Sc_rollup.Whitelist.clear (ctxt, rollup) in
   init ~whitelist ctxt rollup
 
+let make_public ctxt rollup =
+  let open Lwt_result_syntax in
+  let* ctxt = Storage.Sc_rollup.Whitelist.clear (ctxt, rollup) in
+  let* used_storage =
+    Storage.Sc_rollup.Whitelist_used_storage_space.find ctxt rollup
+  in
+  let used_storage = Option.value ~default:Z.zero used_storage in
+  let*! ctxt =
+    Storage.Sc_rollup.Whitelist_used_storage_space.remove ctxt rollup
+  in
+  return (ctxt, used_storage)
+
 let adjust_storage_space ctxt rollup ~new_storage_size =
   let open Lwt_result_syntax in
   let* used_storage =
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
index c29b21d58104..0a2f14b8f970 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
+++ b/src/proto_alpha/lib_protocol/sc_rollup_whitelist_storage.mli
@@ -63,6 +63,12 @@ val replace :
   whitelist:Sc_rollup_whitelist_repr.t ->
   (Raw_context.t * Z.t) tzresult Lwt.t
 
+(** [make_public context rollup] removes the whitelist of [rollup] from
+    the storage thus making the rollup public. Returns the resulting
+    context along with the freed storage space. *)
+val make_public :
+  Raw_context.t -> Sc_rollup_repr.t -> (Raw_context.t * Z.t) tzresult Lwt.t
+
 (** [adjust_storage_space ctxt ~new_storage_size] updates the used
     storage space for the whitelist according to
     [new_storage_size]. The additional positive amount of unpaid
-- 
GitLab


From dc6e76023039454c32fa8ffb0dde5d3d78445cf7 Mon Sep 17 00:00:00 2001
From: Sylvain Ribstein <sylvain.ribstein@gmail.com>
Date: Wed, 26 Jul 2023 10:55:32 +0200
Subject: [PATCH 7/9] soru/client: add whitelist_update case for outbox proof

---
 src/proto_alpha/lib_sc_rollup_client/commands.ml | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/src/proto_alpha/lib_sc_rollup_client/commands.ml b/src/proto_alpha/lib_sc_rollup_client/commands.ml
index ff7ef6a00823..e9db64eb1608 100644
--- a/src/proto_alpha/lib_sc_rollup_client/commands.ml
+++ b/src/proto_alpha/lib_sc_rollup_client/commands.ml
@@ -126,6 +126,7 @@ type unparsed_batch =
       (string * Protocol.Contract_hash.t * Entrypoint.t option) list
   | Atomic_transaction_batch_typed of
       (string * string * Protocol.Contract_hash.t * Entrypoint.t option) list
+  | Whitelist_update of Sc_rollup.Whitelist.t option
 
 let unparsed_batch_encoding =
   let open Data_encoding in
@@ -147,6 +148,12 @@ let unparsed_batch_encoding =
           | Atomic_transaction_batch_typed transactions -> Some transactions
           | _ -> None)
         (fun transactions -> Atomic_transaction_batch_typed transactions);
+      case
+        (Tag 2)
+        ~title:"Whitelist_update"
+        (obj1 @@ req "whitelist" (option Sc_rollup.Whitelist.encoding))
+        (function Whitelist_update whitelist -> Some whitelist | _ -> None)
+        (fun whitelist -> Whitelist_update whitelist);
     ]
 
 let expand_expr expr =
@@ -195,6 +202,8 @@ let parse_unparsed_batch json =
       in
       return
         (Sc_rollup.Outbox.Message.Atomic_transaction_batch_typed {transactions})
+  | Whitelist_update whitelist ->
+      return (Sc_rollup.Outbox.Message.Whitelist_update whitelist)
 
 let outbox_message_parameter =
   Tezos_clic.parameter (fun (cctxt : #Configuration.sc_client_context) str ->
-- 
GitLab


From bced8b18e5ebef3718790da885eb02f31a615097 Mon Sep 17 00:00:00 2001
From: Sylvain Ribstein <sylvain.ribstein@gmail.com>
Date: Mon, 7 Aug 2023 18:12:19 +0200
Subject: [PATCH 8/9] test/proto/soru: add test for the whitelist update

---
 .../integration/operations/test_sc_rollup.ml  | 227 ++++++++++++++++--
 1 file changed, 211 insertions(+), 16 deletions(-)

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 aeeb895cd1c6..198bc2967350 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
@@ -515,8 +515,13 @@ let verify_whitelist ~loc ~expected_whitelist rollup ctxt =
     expected_sorted
     found_sorted
 
-(* Helper function to create output used for executing outbox messages. *)
-let make_output ~outbox_level ~message_index transactions =
+(* Helper functions to create output used for executing outbox messages. *)
+let make_output ~outbox_level ~message_index message =
+  let outbox_level = Raw_level.of_int32_exn (Int32.of_int outbox_level) in
+  let message_index = Z.of_int message_index in
+  Sc_rollup.{outbox_level; message_index; message}
+
+let make_transaction_output ~outbox_level ~message_index transactions =
   let transactions =
     List.map
       (fun (destination, entrypoint, parameters) ->
@@ -527,9 +532,12 @@ let make_output ~outbox_level ~message_index transactions =
   let message =
     Sc_rollup.Outbox.Message.Atomic_transaction_batch {transactions}
   in
-  let outbox_level = Raw_level.of_int32_exn (Int32.of_int outbox_level) in
-  let message_index = Z.of_int message_index in
-  Sc_rollup.{outbox_level; message_index; message}
+  make_output ~outbox_level ~message_index message
+
+let make_whitelist_update_output ~outbox_level ~message_index
+    (whitelist_opt : Sc_rollup.Whitelist.t option) =
+  make_output ~outbox_level ~message_index
+  @@ Sc_rollup.Outbox.Message.Whitelist_update whitelist_opt
 
 let string_ticket_token ticketer content =
   let open Lwt_result_syntax in
@@ -655,7 +663,7 @@ let execute_outbox_message_without_proof_validation block rollup
     ~cemented_commitment outbox_message =
   let open Lwt_result_wrap_syntax in
   let* incr = Incremental.begin_construction block in
-  let*@ res, ctxt =
+  let*@ res, alpha_ctxt =
     Sc_rollup_operations.Internal_for_tests.execute_outbox_message
       (Incremental.alpha_ctxt incr)
       ~validate_and_decode_output_proof:
@@ -665,7 +673,7 @@ let execute_outbox_message_without_proof_validation block rollup
       ~cemented_commitment
       ~output_proof:"Not used"
   in
-  let incr = Incremental.set_alpha_ctxt incr ctxt in
+  let incr = Incremental.set_alpha_ctxt incr alpha_ctxt in
   let* block = Incremental.finalize_block incr in
   return (res, block)
 
@@ -710,6 +718,19 @@ let assert_fails_with ~__LOC__ k expected_err =
   let*! res = k in
   Assert.proto_error ~loc:__LOC__ res (( = ) expected_err)
 
+let verify_can_publish_commit ~__LOC__ ~succeed rollup account block =
+  let open Lwt_result_syntax in
+  let* dummy_commitment = dummy_commitment (B block) rollup in
+  let block_res = publish_commitment account rollup block dummy_commitment in
+  if succeed then
+    let* _block = block_res in
+    return_unit
+  else
+    assert_fails_with
+      ~__LOC__
+      block_res
+      Sc_rollup_errors.Sc_rollup_staker_not_in_whitelist
+
 type balances = {liquid : Tez.t; frozen : Tez.t}
 
 let balances ctxt contract =
@@ -1087,7 +1108,9 @@ let test_single_transaction_batch () =
         {|Pair 42 (Pair "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red" 1)|} );
     ]
   in
-  let output = make_output ~outbox_level:0 ~message_index:0 transactions in
+  let output =
+    make_transaction_output ~outbox_level:0 ~message_index:0 transactions
+  in
   (* Set up the balance so that the self contract owns one ticket. *)
   let* _ticket_hash, block =
     adjust_ticket_token_balance_of_rollup block rollup red_token ~delta:Z.one
@@ -1160,7 +1183,9 @@ let test_older_cemented_commitment () =
           {|Pair 42 (Pair "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red" 1)|} );
       ]
     in
-    let output = make_output ~outbox_level:0 ~message_index:0 transactions in
+    let output =
+      make_transaction_output ~outbox_level:0 ~message_index:0 transactions
+    in
     let* Sc_rollup_operations.{operations; _}, block =
       execute_outbox_message_without_proof_validation
         block
@@ -1285,7 +1310,9 @@ let test_multi_transaction_batch () =
     ]
   in
   (* Create an atomic batch message. *)
-  let output = make_output ~outbox_level:0 ~message_index:0 transactions in
+  let output =
+    make_transaction_output ~outbox_level:0 ~message_index:0 transactions
+  in
   (* Set up the balance so that the rollup owns 10 units of red tokens. *)
   let* _ticket_hash, block =
     adjust_ticket_token_balance_of_rollup
@@ -1349,7 +1376,9 @@ let test_transaction_with_invalid_type () =
   in
   let transactions = [(mutez_receiver, Entrypoint.default, "12")] in
   (* Create an atomic batch message. *)
-  let output = make_output ~outbox_level:0 ~message_index:1 transactions in
+  let output =
+    make_transaction_output ~outbox_level:0 ~message_index:1 transactions
+  in
   assert_fails
     ~loc:__LOC__
     ~error:Sc_rollup_operations.Sc_rollup_invalid_parameters_type
@@ -1383,7 +1412,9 @@ let test_execute_message_twice () =
   in
   (* Create an atomic batch message. *)
   let transactions = [(string_receiver, Entrypoint.default, {|"Hello"|})] in
-  let output = make_output ~outbox_level:0 ~message_index:1 transactions in
+  let output =
+    make_transaction_output ~outbox_level:0 ~message_index:1 transactions
+  in
   (* Execute the message once - should succeed. *)
   let* Sc_rollup_operations.{operations; _}, block =
     execute_outbox_message_without_proof_validation
@@ -1443,7 +1474,9 @@ let test_execute_message_twice_different_cemented_commitments () =
   in
   (* Create an atomic batch message. *)
   let transactions = [(string_receiver, Entrypoint.default, {|"Hello"|})] in
-  let output = make_output ~outbox_level:0 ~message_index:1 transactions in
+  let output =
+    make_transaction_output ~outbox_level:0 ~message_index:1 transactions
+  in
   (* Execute the message once - should succeed. *)
   let* Sc_rollup_operations.{operations; _}, block =
     execute_outbox_message_without_proof_validation
@@ -1500,7 +1533,9 @@ let test_zero_amount_ticket () =
         {|Pair 42 (Pair "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red" 0)|} );
     ]
   in
-  let output = make_output ~outbox_level:0 ~message_index:0 transactions in
+  let output =
+    make_transaction_output ~outbox_level:0 ~message_index:0 transactions
+  in
   let*! result =
     execute_outbox_message_without_proof_validation
       block
@@ -1570,7 +1605,9 @@ let test_execute_message_override_applied_messages_slot () =
   let execute_message incr ~outbox_level ~message_index
       ~cemented_commitment_hash =
     let transactions = [(string_receiver, Entrypoint.default, {|"Hello"|})] in
-    let output = make_output ~outbox_level ~message_index transactions in
+    let output =
+      make_transaction_output ~outbox_level ~message_index transactions
+    in
     let* ( Sc_rollup_operations.
              {operations = _; ticket_receipt = _; paid_storage_size_diff},
            incr ) =
@@ -1726,7 +1763,9 @@ let test_insufficient_ticket_balances () =
     ]
   in
   (* Create an atomic batch message. *)
-  let output = make_output ~outbox_level:0 ~message_index:0 transactions in
+  let output =
+    make_transaction_output ~outbox_level:0 ~message_index:0 transactions
+  in
   (* Set up the balance so that the rollup owns 7 units of red tokens.
      This is insufficient wrt the set of transactions above.
   *)
@@ -3445,6 +3484,145 @@ let test_private_rollup_whitelist_cannot_contain_key_duplication () =
     block_rollup_res
     Sc_rollup_errors.Sc_rollup_duplicated_key_in_whitelist
 
+let update_whitelist ?(message_index = 0)
+    ~(genesis_info : Sc_rollup.Commitment.genesis_info) block rollup
+    updated_whitelist =
+  let open Lwt_result_syntax in
+  let output =
+    make_whitelist_update_output
+      ~outbox_level:0
+      ~message_index
+      updated_whitelist
+  in
+  let* _res, block =
+    execute_outbox_message_without_proof_validation
+      block
+      rollup
+      ~cemented_commitment:genesis_info.commitment_hash
+      output
+  in
+  return block
+
+let verify_whitelist ~__LOC__ block rollup expected_whitelist =
+  verify_whitelist ~loc:__LOC__ rollup (B block) ~expected_whitelist
+
+let verify_can_publish_commit_accounts block rollup accounts =
+  Tezos_base.TzPervasives.List.iter_es
+    (fun (account, succeed) ->
+      verify_can_publish_commit ~__LOC__ ~succeed rollup account block)
+    accounts
+
+let test_check_initial_whitelist () =
+  let open Lwt_result_syntax in
+  let* block, (account1, account2, account3) = context_init Context.T3 in
+  let account1_pkh = Account.pkh_of_contract_exn account1 in
+  let whitelist = Some [account1_pkh] in
+  let* block, rollup = sc_originate ?whitelist block account1 in
+  (* check initial whitelist *)
+  let* () = verify_whitelist ~__LOC__ block rollup whitelist in
+  verify_can_publish_commit_accounts
+    block
+    rollup
+    [(account1, true); (account2, false); (account3, false)]
+
+let test_whitelist_update_duplicated_keys () =
+  let open Lwt_result_syntax in
+  let* block, (account1, account2) = context_init Context.T2 in
+  let account1_pkh = Account.pkh_of_contract_exn account1 in
+  let account2_pkh = Account.pkh_of_contract_exn account2 in
+  let whitelist = Some [account1_pkh] in
+  let* block, rollup = sc_originate ?whitelist block account1 in
+  let* genesis_info = Context.Sc_rollup.genesis_info (B block) rollup in
+  (* replace whitelist with twice the same keys fails *)
+  let updated_whitelist = Some [account2_pkh; account2_pkh] in
+  let block_rollup_res =
+    update_whitelist ~genesis_info block rollup updated_whitelist
+  in
+  assert_fails_with
+    ~__LOC__
+    block_rollup_res
+    Sc_rollup_errors.Sc_rollup_duplicated_key_in_whitelist
+
+let test_whitelist_update_empty_list () =
+  let open Lwt_result_syntax in
+  let* block, account = context_init Context.T1 in
+  let account_pkh = Account.pkh_of_contract_exn account in
+  let whitelist = Some [account_pkh] in
+  let* block, rollup = sc_originate ?whitelist block account in
+  let* genesis_info = Context.Sc_rollup.genesis_info (B block) rollup in
+  (* update to empty list fails *)
+  let updated_whitelist = Some [] in
+  let block_res =
+    update_whitelist ~genesis_info block rollup updated_whitelist
+  in
+  assert_fails_with
+    ~__LOC__
+    block_res
+    Sc_rollup_errors.Sc_rollup_empty_whitelist
+
+let test_whitelist_update_two_keys () =
+  let open Lwt_result_syntax in
+  let* block, (account1, account2, account3) = context_init Context.T3 in
+  let account1_pkh = Account.pkh_of_contract_exn account1 in
+  let account2_pkh = Account.pkh_of_contract_exn account2 in
+  let account3_pkh = Account.pkh_of_contract_exn account3 in
+  let whitelist = Some [account1_pkh] in
+  let* block, rollup = sc_originate ?whitelist block account1 in
+  let* genesis_info = Context.Sc_rollup.genesis_info (B block) rollup in
+
+  (* replace whitelist with two keys succeed *)
+  let updated_whitelist = Some [account2_pkh; account3_pkh] in
+  let* block = update_whitelist ~genesis_info block rollup updated_whitelist in
+  let* () = verify_whitelist ~__LOC__ block rollup updated_whitelist in
+  verify_can_publish_commit_accounts
+    block
+    rollup
+    [(account1, false); (account2, true); (account3, true)]
+
+let test_whitelist_update_make_rollup_public () =
+  let open Lwt_result_syntax in
+  let* block, (account1, account2, account3) = context_init Context.T3 in
+  let account1_pkh = Account.pkh_of_contract_exn account1 in
+  let account2_pkh = Account.pkh_of_contract_exn account2 in
+  let account3_pkh = Account.pkh_of_contract_exn account3 in
+  let whitelist = Some [account1_pkh] in
+  let* block, rollup = sc_originate ?whitelist block account1 in
+  let* genesis_info = Context.Sc_rollup.genesis_info (B block) rollup in
+
+  let* block =
+    (* replace whitelist with two keys succeed *)
+    let updated_whitelist = Some [account2_pkh; account3_pkh] in
+    let* block =
+      update_whitelist ~genesis_info block rollup updated_whitelist
+    in
+    let* () = verify_whitelist ~__LOC__ block rollup updated_whitelist in
+    let* () =
+      verify_can_publish_commit_accounts
+        block
+        rollup
+        [(account1, false); (account2, true); (account3, true)]
+    in
+    return block
+  in
+  (* second update succeed and make the rollup public *)
+  let updated_whitelist = None in
+  let* block =
+    update_whitelist
+      ~genesis_info
+      ~message_index:1
+      block
+      rollup
+      updated_whitelist
+  in
+  let* () = verify_whitelist ~__LOC__ block rollup updated_whitelist in
+  let* () =
+    verify_can_publish_commit_accounts
+      block
+      rollup
+      [(account1, true); (account2, true); (account3, true)]
+  in
+  return_unit
+
 let tests =
   [
     Tztest.tztest
@@ -3606,6 +3784,23 @@ let tests =
       "Originate a rollup with duplicated key in the whitelist fails"
       `Quick
       test_private_rollup_whitelist_cannot_contain_key_duplication;
+    Tztest.tztest "Check initial whitelist" `Quick test_check_initial_whitelist;
+    Tztest.tztest
+      "Update the whitelist with duplicated keys"
+      `Quick
+      test_whitelist_update_duplicated_keys;
+    Tztest.tztest
+      "Update the whitelist with an empty list"
+      `Quick
+      test_whitelist_update_empty_list;
+    Tztest.tztest
+      "Update the whitelist with two distinct keys"
+      `Quick
+      test_whitelist_update_two_keys;
+    Tztest.tztest
+      "Update the whitelist to make the rollup public"
+      `Quick
+      test_whitelist_update_make_rollup_public;
   ]
 
 let () =
-- 
GitLab


From 51d2202acd9cdb9516874ba53c2e614c5d332a32 Mon Sep 17 00:00:00 2001
From: Sylvain Ribstein <sylvain.ribstein@gmail.com>
Date: Mon, 7 Aug 2023 18:12:42 +0200
Subject: [PATCH 9/9] tezt/soru: add update whitelist test for private rollup

---
 tezt/tests/sc_rollup.ml | 138 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 137 insertions(+), 1 deletion(-)

diff --git a/tezt/tests/sc_rollup.ml b/tezt/tests/sc_rollup.ml
index c9d4b7075b29..6266fea1b117 100644
--- a/tezt/tests/sc_rollup.ml
+++ b/tezt/tests/sc_rollup.ml
@@ -57,6 +57,20 @@ let get_last_stored_commitment =
 let get_last_published_commitment =
   assert_some_client_command Sc_rollup_client.last_published_commitment
 
+let get_outbox_proof ?hooks ?expected_error ~__LOC__ sc_rollup ~message_index
+    ~outbox_level =
+  let* proof =
+    Sc_rollup_client.outbox_proof
+      ?hooks
+      ?expected_error
+      sc_rollup
+      ~message_index
+      ~outbox_level
+  in
+  match proof with
+  | Some v -> return v
+  | None -> failwith (Format.asprintf "Unexpected [None] at %s" __LOC__)
+
 (* Number of levels needed to process a head as finalized. This value should
    be the same as `node_context.block_finality_time`, where `node_context` is
    the `Node_context.t` used by the rollup node. For Tenderbake, the
@@ -5671,6 +5685,127 @@ let test_private_rollup_node_publish_not_in_whitelist =
     ~exit_code:1
     ~msg:(rex ".*The operator is not in the whitelist.*")
 
+let test_rollup_whitelist_update ~kind =
+  let commitment_period = 2 and challenge_window = 5 in
+  let whitelist = [Constant.bootstrap1.public_key_hash] in
+  test_full_scenario
+    {variant = None; tags = ["whitelist"]; description = "whitelist"}
+    ~kind
+    ~whitelist_enable:true
+    ~whitelist
+    ~supports:(From_protocol 019)
+    ~commitment_period
+    ~challenge_window
+    ~operator:Constant.bootstrap1.public_key_hash
+  @@ fun _protocol rollup_node rollup_client rollup_addr node client ->
+  let* () = Sc_rollup_node.run rollup_node rollup_addr [] in
+  let*! payload_index0 =
+    Sc_rollup_client.encode_json_outbox_msg rollup_client
+    @@ `O
+         [
+           ( "whitelist",
+             `A
+               [
+                 `String Constant.bootstrap1.public_key_hash;
+                 `String Constant.bootstrap2.public_key_hash;
+               ] );
+         ]
+  in
+  let*! payload_index1 =
+    Sc_rollup_client.encode_json_outbox_msg rollup_client
+    @@ `O [("whitelist", `Null)]
+  in
+  let* () =
+    send_text_messages
+      ~hooks
+      ~format:`Hex
+      client
+      [payload_index0; payload_index1]
+  in
+  let outbox_level = Node.get_level node in
+  let blocks_to_wait = 3 + (2 * commitment_period) + challenge_window in
+  let* () =
+    repeat blocks_to_wait @@ fun () -> Client.bake_for_and_wait client
+  in
+  let* outbox =
+    Runnable.run @@ Sc_rollup_client.outbox ~outbox_level rollup_client
+  in
+  let*! commitment = Sc_rollup_client.last_published_commitment rollup_client in
+  let Sc_rollup_client.{commitment_and_hash = {commitment; _}; _} =
+    Option.get commitment
+  in
+  (* Bootstrap2 attempts to publish a commitments while not present in the whitelist. *)
+  let*? process =
+    publish_commitment
+      ~src:Constant.bootstrap2.alias
+      ~commitment
+      client
+      rollup_addr
+  in
+  let* output_err =
+    Process.check_and_read_stderr ~expect_failure:true process
+  in
+  (* The attempt at publishing a commitment fails. *)
+  Check.(
+    (output_err
+    =~ rex
+         ".*The rollup is private and the submitter of the commitment is not \
+          present in the whitelist.*")
+      ~error_msg:"Expected output \"%L\" to match expression \"%R\".") ;
+  Log.info "Outbox is %s" (JSON.encode outbox) ;
+  (* Execute the first outbox message that updates the whitelist [payload_index0]
+     to add Bootstrap2. *)
+  let* {commitment_hash; proof} =
+    get_outbox_proof rollup_client ~__LOC__ ~message_index:0 ~outbox_level
+  in
+  let*! () =
+    Client.Sc_rollup.execute_outbox_message
+      ~hooks
+      ~burn_cap:(Tez.of_int 10)
+      ~rollup:rollup_addr
+      ~src:Constant.bootstrap3.alias
+      ~commitment_hash
+      ~proof
+      client
+  in
+  let* () = Client.bake_for_and_wait client in
+  (* Bootstrap2 attempts to publish a commitments while not present in the whitelist,
+     once again. *)
+  let*! () =
+    publish_commitment
+      ~src:Constant.bootstrap2.alias
+      ~commitment
+      client
+      rollup_addr
+  in
+  (* The above operation succeeds. *)
+  (* Execute the second outbox message that updates the whitelist [payload_index1]
+     and set it to [None]. *)
+  let* {commitment_hash; proof} =
+    get_outbox_proof rollup_client ~__LOC__ ~message_index:1 ~outbox_level
+  in
+  let*! () =
+    Client.Sc_rollup.execute_outbox_message
+      ~hooks
+      ~burn_cap:(Tez.of_int 10)
+      ~rollup:rollup_addr
+      ~src:Constant.bootstrap3.alias
+      ~commitment_hash
+      ~proof
+      client
+  in
+  let* () = Client.bake_for_and_wait client in
+  let*! () =
+    publish_commitment
+      ~src:Constant.bootstrap3.alias
+      ~commitment
+      client
+      rollup_addr
+  in
+  (* The rollup being public anyone can publish a commitment so the above operation
+     succeeds. *)
+  unit
+
 let register ~kind ~protocols =
   test_origination ~kind protocols ;
   test_rollup_node_running ~kind protocols ;
@@ -5852,7 +5987,8 @@ let register ~protocols =
   test_private_rollup_whitelisted_staker protocols ;
   test_private_rollup_non_whitelisted_staker protocols ;
   test_private_rollup_node_publish_in_whitelist protocols ;
-  test_private_rollup_node_publish_not_in_whitelist protocols
+  test_private_rollup_node_publish_not_in_whitelist protocols ;
+  test_rollup_whitelist_update ~kind:"wasm_2_0_0" protocols
 
 let register_migration ~kind ~migrate_from ~migrate_to =
   test_migration_inbox ~kind ~migrate_from ~migrate_to ;
-- 
GitLab