Proto/Env: Replace configure_sandbox by proper init

src/bin_client/test/demo/main.ml

@@ -95,4 +95,10 @@ let finalize_block ctxt =
 
 let rpc_services = RPC_directory.empty
 
-let configure_sandbox ctxt _ = Lwt.return (Ok ctxt)
+let init ctxt block_header =
+  let fitness = block_header.Block_header.fitness in
+  let message = None in
+  return { Updater.message ; context = ctxt ; fitness ;
+           max_operations_ttl = 0 ; max_operation_data_length = 0 ;
+           last_allowed_fork_level = 0l ;
+         }

src/bin_client/test/test_basic.sh

@@ -11,12 +11,11 @@ activate_alpha
 sleep 2
 
 #tests for the rpc service raw_context
-$client rpc call '/blocks/head/raw_context/version' | assert '{ "content": "67656e65736973" }'
+$client rpc call '/blocks/head/raw_context/version' | assert '{ "content": "616c706861" }'
 $client rpc call '/blocks/head/raw_context/non-existent' | assert 'No service found at this URL'
-$client rpc call '/blocks/head/raw_context?depth=2' | assert '{ "content":
+$client rpc call '/blocks/head/raw_context/delegates/?depth=2' | assert '{ "content":
-    { "genesis_key":
+    { "02": { "29": null }, "a9": { "ce": null }, "c5": { "5c": null },
-        "68b4bf512517497dbd944de6825ab0a0fed7ff51bdd6b77596a19cc9175ddd55",
+      "da": { "c9": null }, "e7": { "67": null } } }'
-      "v1": { "sandboxed": null }, "version": "67656e65736973" } }'
 $client rpc call '/blocks/head/raw_context/non-existent?depth=-1' | assert 'No service found at this URL'
 $client rpc call '/blocks/head/raw_context/non-existent?depth=0' | assert 'No service found at this URL'
 

src/bin_client/test/test_injection.sh

@@ -14,7 +14,7 @@ show_logs="no"
 sleep 2
 
 # autogenerated from the demo source
-protocol_version="Ps1ZDZdgRP4PFDkzmFpiYtE7gJHioavCMxC96i9zJsK6URwSXSJ"
+protocol_version="PsxS1brZfzzXCiFwirbMtQr4X5XR6SiHQ46HajpFDdk9GBXR6vy"
 
 $admin_client inject protocol "$test_dir/demo"
 $admin_client list protocols

src/bin_node/node_run_command.ml

@@ -92,32 +92,44 @@ let init_logger ?verbosity (log_config : Node_config_file.log) =
 
 let init_node ?sandbox (config : Node_config_file.t) =
   let patch_context json ctxt =
+    begin
+      match json with
+      | None -> Lwt.return ctxt
+      | Some json ->
+          Tezos_storage.Context.set ctxt
+            ["sandbox_parameter"]
+            (Data_encoding.Binary.to_bytes Data_encoding.json json)
+    end >>= fun ctxt ->
     let module Proto = (val Registered_protocol.get_exn genesis.protocol) in
-    protect begin fun () ->
+    Proto.init ctxt {
-      Proto.configure_sandbox ctxt json
+      level = 0l ;
-    end >|= function
+      proto_level = 0 ;
-    | Error err ->
+      predecessor = genesis.block ;
-        warn
+      timestamp = genesis.time ;
-          "@[Error while configuring ecoproto for the sandboxed mode:@ %a@]"
+      validation_passes = 0 ;
-          pp_print_error err ;
+      operations_hash = Operation_list_list_hash.empty ;
-        ctxt
+      fitness = [] ;
-    | Ok ctxt -> ctxt in
+      context = Context_hash.zero ;
+    } >>= function
+    | Error _ -> assert false (* FIXME error *)
+    | Ok { context = ctxt ; _ } ->
+        Lwt.return ctxt in
   begin
     match sandbox with
     | None -> Lwt.return_none
     | Some sandbox_param ->
         match sandbox_param with
-        | None -> Lwt.return (Some (patch_context None))
+        | None -> Lwt.return None
         | Some file ->
             Lwt_utils_unix.Json.read_file file >>= function
             | Error err ->
                 lwt_warn
                   "Can't parse sandbox parameters: %s" file >>= fun () ->
                 lwt_debug "%a" pp_print_error err >>= fun () ->
-                Lwt.return (Some (patch_context None))
+                Lwt.return None
             | Ok json ->
-                Lwt.return (Some (patch_context (Some json)))
+                Lwt.return (Some json)
-  end >>= fun patch_context ->
+  end >>= fun sandbox_param ->
   (* TODO "WARN" when pow is below our expectation. *)
   begin
     match config.p2p.listen_addr with
@@ -163,7 +175,7 @@ let init_node ?sandbox (config : Node_config_file.t) =
   end >>=? fun p2p_config ->
   let node_config : Node.config = {
     genesis ;
-    patch_context ;
+    patch_context = Some (patch_context sandbox_param) ;
     store_root = store_dir config.data_dir ;
     context_root = context_dir config.data_dir ;
     p2p = p2p_config ;

src/lib_protocol_environment/sigs/v1/data_encoding.mli

@@ -227,6 +227,8 @@ module Json : sig
   val cannot_destruct : ('a, Format.formatter, unit, 'b) format4 -> 'a
   val wrap_error : ('a -> 'b) -> 'a -> 'b
 
+  val pp : Format.formatter -> json -> unit
+
 end
 
 module Binary : sig

src/lib_protocol_environment/sigs/v1/updater.mli

@@ -155,11 +155,12 @@ module type PROTOCOL = sig
   (** The list of remote procedures exported by this implementation *)
   val rpc_services: rpc_context Lwt.t RPC_directory.t
 
-  (** An ad-hoc context patcher. It used only for debugging protocol
+  (** Initialize the context (or upgrade the context after a protocol
-      while running in the "sandbox" mode. This function is never used
+      amendment). This function receives the context resulting of the
-      in production. *)
+      application of a block that triggered the amendment. It also
-  val configure_sandbox:
+      receives the header of the block that triggered the amendment. *)
-    Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t
+  val init:
+    Context.t -> Block_header.shell_header -> validation_result tzresult Lwt.t
 
 end
 

src/lib_protocol_environment/tezos_protocol_environment.ml

@@ -93,8 +93,8 @@ module Make (Context : CONTEXT) = struct
     val finalize_block:
       validation_state -> validation_result tzresult Lwt.t
     val rpc_services: rpc_context Lwt.t RPC_directory.t
-    val configure_sandbox:
+    val init:
-      context -> Data_encoding.json option -> context tzresult Lwt.t
+      context -> Block_header.shell_header -> validation_result tzresult Lwt.t
   end
 
   module type PROTOCOL =
@@ -581,8 +581,7 @@ module Make (Context : CONTEXT) = struct
         apply_operation c o >|= wrap_error
       let finalize_block c = finalize_block c >|= wrap_error
       let parse_operation h b = parse_operation h b |> wrap_error
-      let configure_sandbox c j =
+      let init c bh = init c bh >|= wrap_error
-        configure_sandbox c j >|= wrap_error
     end
 
     class ['block] proto_rpc_context

src/lib_protocol_environment/tezos_protocol_environment.mli

@@ -86,8 +86,8 @@ module Make (Context : CONTEXT) : sig
     val finalize_block:
       validation_state -> validation_result tzresult Lwt.t
     val rpc_services: rpc_context Lwt.t RPC_directory.t
-    val configure_sandbox:
+    val init:
-      context -> Data_encoding.json option -> context tzresult Lwt.t
+      context -> Block_header.shell_header -> validation_result tzresult Lwt.t
   end
 
   module type PROTOCOL =

src/lib_shell/block_validator.ml

@@ -167,8 +167,8 @@ let apply_block
       Proto.apply_operation state op >>=? fun state ->
       return state))
     state parsed_operations >>=? fun state ->
-  Proto.finalize_block state >>=? fun new_context ->
+  Proto.finalize_block state >>=? fun validation_result ->
-  Context.get_protocol new_context.context >>= fun new_protocol ->
+  Context.get_protocol validation_result.context >>= fun new_protocol ->
   let expected_proto_level =
     if Protocol_hash.equal new_protocol Proto.hash then
       pred_header.shell.proto_level
@@ -180,19 +180,30 @@ let apply_block
         expected = expected_proto_level ;
       }) >>=? fun () ->
   fail_when
-    Fitness.(new_context.fitness <> header.shell.fitness)
+    Fitness.(validation_result.fitness <> header.shell.fitness)
     (invalid_block hash @@ Invalid_fitness {
         expected = header.shell.fitness ;
-        found = new_context.fitness ;
+        found = validation_result.fitness ;
       }) >>=? fun () ->
+  begin
+    if Protocol_hash.equal new_protocol Proto.hash then
+      return validation_result
+    else
+      match Registered_protocol.get new_protocol with
+      | None ->
+          fail (Unavailable_protocol { block = hash ;
+                                       protocol = new_protocol })
+      | Some (module NewProto) ->
+          NewProto.init validation_result.context header.shell
+  end >>=? fun validation_result ->
   let max_operations_ttl =
     max 0
       (min
          ((State.Block.max_operations_ttl pred)+1)
-         new_context.max_operations_ttl) in
+         validation_result.max_operations_ttl) in
-  let new_context =
+  let validation_result =
-    { new_context with max_operations_ttl } in
+    { validation_result with max_operations_ttl } in
-  return new_context
+  return validation_result
 
 let check_chain_liveness chain_db hash (header: Block_header.t) =
   let chain_state = Distributed_db.chain_state chain_db in

src/lib_shell/node.ml

@@ -335,7 +335,6 @@ module RPC = struct
         pred_shell_header.proto_level
       else
         ((pred_shell_header.proto_level + 1) mod 256) in
-    Context.commit ?message ~time:timestamp context >>= fun context ->
     let shell_header : Block_header.shell_header = {
       level = Int32.succ pred_shell_header.level ;
       proto_level ;
@@ -344,9 +343,22 @@ module RPC = struct
       validation_passes = List.length rs ;
       operations_hash ;
       fitness ;
-      context ;
+      context = Context_hash.zero ; (* place holder *)
     } in
-    return (shell_header, rs)
+    begin
+      if Protocol_hash.equal protocol pred_protocol then
+        return (context, message)
+      else
+        match Registered_protocol.get protocol with
+        | None ->
+            fail (Block_validator_errors.Unavailable_protocol
+                    { block = State.Block.hash predecessor ; protocol })
+        | Some (module NewProto) ->
+            NewProto.init context shell_header >>=? fun { context ; message ; _ } ->
+            return (context, message)
+    end >>=? fun (context, message) ->
+    Context.commit ?message ~time:timestamp context >>= fun context ->
+    return ({ shell_header with context }, rs)
 
   let complete node ?block str =
     match block with

src/lib_storage/context.ml

@@ -102,7 +102,6 @@ let checkout index key =
   | Some commit ->
       GitStore.Commit.tree commit >>= fun tree ->
       let ctxt = { index ; tree ; parents = [commit] } in
-      index.patch_context ctxt >>= fun ctxt ->
       Lwt.return (Some ctxt)
 
 let checkout_exn index key =

src/proto_alpha/lib_baking/test/test_endorsement.ml

@@ -199,7 +199,7 @@ let test_endorsement_rights contract block =
 
 let run genesis =
 
-  Helpers.Baking.bake genesis b1 [] >>=? fun blk ->
+  Helpers.Baking.bake genesis b2 [] >>=? fun blk ->
 
   let block = `Hash (blk, 0) in
   test_endorsement_rights
@@ -211,9 +211,9 @@ let run genesis =
   Assert.equal_bool ~msg:__LOC__ has_right_to_endorse true ;
 
   Assert.balance_equal
-    ~block:block ~msg:__LOC__ b1 3_999_488_000_000L >>=? fun () ->
+    ~block:block ~msg:__LOC__ b1 4_000_000_000_000L >>=? fun () ->
   Assert.balance_equal
-    ~block:block ~msg:__LOC__ b2 4_000_000_000_000L >>=? fun () ->
+    ~block:block ~msg:__LOC__ b2 3_999_488_000_000L >>=? fun () ->
   Assert.balance_equal
     ~block:block ~msg:__LOC__ b3 4_000_000_000_000L >>=? fun () ->
   Assert.balance_equal

src/proto_alpha/lib_baking/test/test_rpc.ml

@@ -26,21 +26,18 @@ let run blkid =
   in
 
   (* files and directories that are in context *)
-  let version = Key (MBytes.of_hex (`Hex "67656e65736973")) in
+  let version = Key (MBytes.of_hex (`Hex "616c706861")) in
-  let genesis_key = Key (MBytes.of_hex (`Hex "68b4bf512517497dbd944de6825ab0a0fed7ff51bdd6b77596a19cc9175ddd55")) in
   let dir_depth0 = Cut in
-  let dir_depth1 = Dir [("genesis_key", Cut);
+  let dir_depth2 = Dir [("02", Dir [("29", Cut)]);
-                        ("v1", Cut);
+                        ("a9", Dir [("ce", Cut)]);
-                        ("version", Cut)] in
+                        ("c5", Dir [("5c", Cut)]);
-  let dir_depth2 = Dir [("genesis_key", genesis_key);
+                        ("da", Dir [("c9", Cut)]);
-                        ("v1", Dir [("sandboxed",Cut)]);
+                        ("e7", Dir [("67", Cut)]);
-                        ("version", version)] in
+                       ] in
 
   let tests = [(("version",1), is_equal version);
                (("",0), is_equal dir_depth0);
-               (("",1), is_equal dir_depth1);
+               (("delegates",2), is_equal dir_depth2);
-               (("",2), is_equal dir_depth2);
-               (("",2), is_equal dir_depth2);
                (("",-1), is_not_found);
                (("not-existent",1), is_not_found);
                (("not-existent",0), is_not_found);

src/proto_alpha/lib_baking/test/test_vote.ml

@@ -78,7 +78,6 @@ let run_change_to_demo_proto block
   (* Mine blocks to switch to end the vote cycle (back to Proposal) *)
   Format.eprintf "Switching to `demo` protocol@.";
   Baking.bake (`Hash (head, 0)) b4 operations >>=? fun head ->
-  Baking.bake (`Hash (head, 0)) b5 [] >>=? fun head ->
 
   Assert.check_protocol
     ~msg:__LOC__ ~block:(`Hash (head, 0)) demo_protocol >>=? fun () ->

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -95,7 +95,8 @@ module Commitment = struct
   include Commitment_storage
 end
 
-let init = Init_storage.may_initialize
+let prepare_first_block = Init_storage.prepare_first_block
+let prepare = Init_storage.prepare
 
 let finalize ?commit_message:message c =
   let fitness = Fitness.from_int64 (Fitness.current c) in
@@ -107,8 +108,6 @@ let finalize ?commit_message:message c =
       Raw_level.to_int32 @@ Level.last_allowed_fork_level c;
   }
 
-let configure_sandbox = Raw_context.configure_sandbox
-
 let activate = Raw_context.activate
 let fork_test_chain = Raw_context.fork_test_chain
 

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -766,16 +766,21 @@ module Commitment : sig
 
 end
 
-val init:
+val prepare_first_block:
   Context.t ->
   level:Int32.t ->
   timestamp:Time.t ->
   fitness:Fitness.t ->
   context tzresult Lwt.t
-val finalize: ?commit_message:string -> context -> Updater.validation_result
 
-val configure_sandbox:
+val prepare:
-  Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t
+  Context.t ->
+  level:Int32.t ->
+  timestamp:Time.t ->
+  fitness:Fitness.t ->
+  context tzresult Lwt.t
+
+val finalize: ?commit_message:string -> context -> Updater.validation_result
 
 val activate: context -> Protocol_hash.t -> context Lwt.t
 val fork_test_chain: context -> Protocol_hash.t -> Time.t -> context Lwt.t

src/proto_alpha/lib_protocol/src/alpha_services.ml

@@ -117,18 +117,13 @@ module Context = struct
 
   end
 
-  type error += Unexpected_level_in_context
-
   let () =
     let open Services_registration in
     register0 S.level begin fun ctxt () () ->
-      let level = Level.current ctxt in
+      return (Level.current ctxt)
-      match Level.pred ctxt level with
-      | None -> fail Unexpected_level_in_context
-      | Some level -> return level
     end ;
     register0 S.next_level begin fun ctxt () () ->
-      return (Level.current ctxt)
+      return (Level.succ ctxt (Level.current ctxt))
     end ;
     register0 S.voting_period_kind begin fun ctxt () () ->
       Vote.get_current_period_kind ctxt
@@ -203,9 +198,6 @@ module Nonce = struct
     end ;
     register0 S.hash begin fun ctxt () () ->
       let level = Level.current ctxt in
-      match Level.pred ctxt level with
-      | None -> fail Context.Unexpected_level_in_context
-      | Some level ->
       Nonce.get ctxt level >>=? function
       | Unrevealed { nonce_hash ; _ } -> return nonce_hash
       | _ -> assert false

src/proto_alpha/lib_protocol/src/constants_repr.ml

@@ -241,14 +241,18 @@ let constants_encoding =
            ))
         unit)
 
-type error += Constant_read of exn
+type error += Constant_read of string
 
 let read = function
   | None ->
       return default
   | Some json ->
       match Data_encoding.Json.(destruct constants_encoding json) with
-      | exception exn -> fail (Constant_read exn)
+      | exception (Data_encoding.Json.Cannot_destruct _ as exn) ->
+          Format.kasprintf
+            failwith "Invalid sandbox: %a %a"
+            (fun ppf -> Data_encoding.Json.print_error ppf) exn
+            Data_encoding.Json.pp json
       | c ->
           if Compare.Int32.(c.blocks_per_roll_snapshot > c.blocks_per_cycle) then
             failwith "Invalid sandbox: 'blocks_per_roll_snapshot > blocks_per_cycle'"

src/proto_alpha/lib_protocol/src/delegate_services.ml

@@ -113,7 +113,7 @@ module Baker = struct
       return (level.level, prio)
 
     let baking_rights ctxt () max =
-      let level = Level.current ctxt in
+      let level = Level.succ ctxt (Level.current ctxt) in
       baking_rights_for_level ctxt level max >>=? fun (raw_level, slots) ->
       begin
         Lwt_list.filter_map_p (fun x -> x) @@
@@ -130,7 +130,7 @@ module Baker = struct
     let baking_rights_for_delegate
         ctxt contract () (max_priority, min_level, max_level) =
       let max_priority = default_max_baking_priority ctxt max_priority in
-      let current_level = Level.current ctxt in
+      let current_level = Level.succ ctxt (Level.current ctxt) in
       let min_level = match min_level with
         | None -> current_level
         | Some l -> Level.from_raw ctxt l in
@@ -276,7 +276,7 @@ module Endorser = struct
       let current_level = Level.current ctxt in
       let max_priority = default_max_endorsement_priority ctxt max_priority in
       let min_level = match min_level with
-        | None -> Level.succ ctxt current_level
+        | None -> current_level
         | Some l -> Level.from_raw ctxt l in
       let max_level =
         match max_level with

src/proto_alpha/lib_protocol/src/helpers_services.ml

@@ -133,7 +133,7 @@ module I = struct
     | None -> Error_monad.fail Operation.Cannot_parse_operation
     | Some (shell, contents) ->
         let operation = { shell ; contents ; signature } in
-        let level = Alpha_context.Level.current ctxt in
+        let level = Level.succ ctxt (Level.current ctxt) in
         Baking.baking_priorities ctxt level >>=? fun (Misc.LCons (baker_pk, _)) ->
         let baker_pkh = Ed25519.Public_key.hash baker_pk in
         let block_prio = 0 in

src/proto_alpha/lib_protocol/src/init_storage.ml

@@ -8,7 +8,9 @@
 (**************************************************************************)
 
 (* This is the genesis protocol: initialise the state *)
-let initialize ctxt =
+let prepare_first_block ctxt ~level ~timestamp ~fitness =
+  Raw_context.prepare_first_block
+    ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
   Roll_storage.init ctxt >>=? fun ctxt ->
   Seed_storage.init ctxt >>=? fun ctxt ->
   Contract_storage.init ctxt >>=? fun ctxt ->
@@ -18,10 +20,5 @@ let initialize ctxt =
   Commitment_storage.init ctxt >>=? fun ctxt ->
   return ctxt
 
-let may_initialize ctxt ~level ~timestamp ~fitness =
+let prepare ctxt ~level ~timestamp ~fitness =
-  Raw_context.prepare
+  Raw_context.prepare ~level ~timestamp ~fitness ctxt
-    ~level ~timestamp ~fitness ctxt >>=? fun (ctxt, first_block) ->
-  if first_block then
-    initialize ctxt
-  else
-    return ctxt

src/proto_alpha/lib_protocol/src/main.ml

@@ -69,7 +69,7 @@ let begin_application
   let level = block_header.shell.level in
   let fitness = pred_fitness in
   let timestamp = block_header.shell.timestamp in
-  Alpha_context.init ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
+  Alpha_context.prepare ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
   Apply.begin_application
     ctxt block_header pred_timestamp >>=? fun (ctxt, baker, deposit) ->
   let mode = Application { block_header ; baker = Ed25519.Public_key.hash baker } in
@@ -88,7 +88,7 @@ let begin_construction
     () =
   let level = Int32.succ pred_level in
   let fitness = pred_fitness in
-  Alpha_context.init ~timestamp ~level ~fitness ctxt >>=? fun ctxt ->
+  Alpha_context.prepare ~timestamp ~level ~fitness ctxt >>=? fun ctxt ->
   begin
     match protocol_data with
     | None ->
@@ -153,4 +153,10 @@ let finalize_block { mode ; ctxt ; op_count ; deposit ; fees ; rewards } =
 let compare_operations op1 op2 =
   Apply.compare_operations op1 op2
 
-let configure_sandbox = Alpha_context.configure_sandbox
+let init ctxt block_header =
+  let level = block_header.Block_header.level in
+  let fitness = block_header.fitness in
+  let timestamp = block_header.timestamp in
+  Alpha_context.prepare_first_block
+    ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
+  return (Alpha_context.finalize ctxt)

src/proto_alpha/lib_protocol/src/raw_context.ml

@@ -120,22 +120,12 @@ let storage_error err = fail (Storage_error err)
 let version_key = ["version"]
 let version_value = "alpha"
 
-let is_first_block ctxt =
-  Context.get ctxt version_key >>= function
-  | None ->
-      return true
-  | Some bytes ->
-      let s = MBytes.to_string bytes in
-      if Compare.String.(s = version_value) then
-        return false
-      else if Compare.String.(s = "genesis") then
-        return true
-      else
-        storage_error (Incompatible_protocol_version s)
-
 let version = "v1"
 let first_level_key = [ version ; "first_level" ]
-let sandboxed_key = [ version ; "sandboxed" ]
+let constants_key = [ version ; "constants" ]
+
+(* temporary hardcoded key to be removed... *)
+let sandbox_param_key = [ "sandbox_parameter" ]
 
 let get_first_level ctxt =
   Context.get ctxt first_level_key >>= function
@@ -171,35 +161,49 @@ let () =
     (function Failed_to_parse_sandbox_parameter data -> Some data | _ -> None)
     (fun data -> Failed_to_parse_sandbox_parameter data)
 
-let get_sandboxed c =
+let get_sandbox_param c =
-  Context.get c sandboxed_key >>= function
+  Context.get c sandbox_param_key >>= function
   | None -> return None
   | Some bytes ->
       match Data_encoding.Binary.of_bytes Data_encoding.json bytes with
       | None -> fail (Failed_to_parse_sandbox_parameter bytes)
       | Some json -> return (Some json)
 
-let set_sandboxed c json =
+let set_constants ctxt constants =
-  Context.set c sandboxed_key
+  let bytes =
-    (Data_encoding.Binary.to_bytes Data_encoding.json json)
+    Data_encoding.Binary.to_bytes
+      Constants_repr.constants_encoding constants in
+  Context.set ctxt constants_key bytes
 
-let may_tag_first_block ctxt level =
+let get_constants ctxt =
-  is_first_block ctxt >>=? function
+  Context.get ctxt constants_key >>= function
-  | false ->
+  | None ->
-      get_first_level ctxt >>=? fun level ->
+      failwith "Internal error: cannot read constants in context."
-      return (ctxt, false, level)
+  | Some bytes ->
-  | true ->
+      match
-      Context.set ctxt version_key
+        Data_encoding.Binary.of_bytes Constants_repr.constants_encoding bytes
-        (MBytes.of_string version_value) >>= fun ctxt ->
+      with
-      set_first_level ctxt level >>=? fun ctxt ->
+      | None ->
-      return (ctxt, true, level)
+          failwith "Internal error: cannot parse constants in context."
+      | Some constants -> return constants
+
+let check_inited ctxt =
+  Context.get ctxt version_key >>= function
+  | None ->
+      failwith "Internal error: un-initialized context."
+  | Some bytes ->
+      let s = MBytes.to_string bytes in
+      if Compare.String.(s = version_value) then
+        return ()
+      else
+        storage_error (Incompatible_protocol_version s)
 
 let prepare ~level ~timestamp ~fitness ctxt =
   Lwt.return (Raw_level_repr.of_int32 level) >>=? fun level ->
   Lwt.return (Fitness_repr.to_int64 fitness) >>=? fun fitness ->
-  may_tag_first_block ctxt level >>=? fun (ctxt, first_block, first_level) ->
+  check_inited ctxt >>=? fun () ->
-  get_sandboxed ctxt >>=? fun sandbox ->
+  get_constants ctxt >>=? fun constants ->
-  Constants_repr.read sandbox >>=? fun constants ->
+  get_first_level ctxt >>=? fun first_level ->
   let level =
     Level_repr.from_raw
       ~first_level
@@ -207,11 +211,34 @@ let prepare ~level ~timestamp ~fitness ctxt =
       ~blocks_per_voting_period:constants.Constants_repr.blocks_per_voting_period
       ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
       level in
-  return ({ context = ctxt ; constants ; level ;
+  return {
+    context = ctxt ; constants ; level ;
     timestamp ; fitness ; first_level ;
     endorsements_received = Int_set.empty ;
-          },
+  }
-          first_block)
+
+let check_first_block ctxt =
+  Context.get ctxt version_key >>= function
+  | None -> return ()
+  | Some bytes ->
+      let s = MBytes.to_string bytes in
+      if Compare.String.(s = version_value) then
+        failwith "Internal error: previously initialized context."
+      else if Compare.String.(s = "genesis") then
+        return ()
+      else
+        storage_error (Incompatible_protocol_version s)
+
+let prepare_first_block ~level ~timestamp ~fitness ctxt =
+  check_first_block ctxt >>=? fun () ->
+  Lwt.return (Raw_level_repr.of_int32 level) >>=? fun first_level ->
+  get_sandbox_param ctxt >>=? fun sandbox_param ->
+  Constants_repr.read sandbox_param >>=? fun constants ->
+  Context.set ctxt version_key
+    (MBytes.of_string version_value) >>= fun ctxt ->
+  set_first_level ctxt first_level >>=? fun ctxt ->
+  set_constants ctxt constants >>= fun ctxt ->
+  prepare ctxt ~level ~timestamp ~fitness
 
 let activate ({ context = c ; _ } as s) h =
   Updater.activate c h >>= fun c -> Lwt.return { s with context = c }
@@ -233,45 +260,6 @@ let register_resolvers enc resolve =
     resolve faked_context str in
   Context.register_resolver enc  resolve
 
-type error += Unimplemented_sandbox_migration
-
-let configure_sandbox ctxt json =
-  let rec json_equals x y = match x, y with
-    | `Float x, `Float y -> Compare.Float.(x = y)
-    | `Bool x, `Bool y -> Compare.Bool.(x = y)
-    | `String x, `String y -> Compare.String.(x = y)
-    | `Null, `Null -> true
-    | `O x, `O y ->
-        let sort =
-          List.sort (fun (a, _) (b, _) -> Compare.String.compare a b) in
-        Compare.Int.(=) (List.length x) (List.length y) &&
-        List.for_all2
-          (fun (nx, vx) (ny, vy) ->
-             Compare.String.(nx = ny) && json_equals vx vy)
-          (sort x) (sort y)
-    | `A x, `A y ->
-        Compare.Int.(=) (List.length x) (List.length y) &&
-        List.for_all2 json_equals x y
-    | _, _ -> false
-  in
-  let json =
-    match json with
-    | None -> `O []
-    | Some json -> json in
-  is_first_block ctxt >>=? function
-  | true ->
-      set_sandboxed ctxt json >>= fun ctxt ->
-      return ctxt
-  | false ->
-      get_sandboxed ctxt >>=? function
-      | None ->
-          fail Unimplemented_sandbox_migration
-      | Some existing ->
-          if json_equals existing json then
-            return ctxt
-          else
-            failwith "Changing sandbox parameter is not yet implemented"
-
 (* Generic context ********************************************************)
 
 type key = string list

src/proto_alpha/lib_protocol/src/raw_context.mli

@@ -35,7 +35,13 @@ val prepare:
   level: Int32.t ->
   timestamp: Time.t ->
   fitness: Fitness.t ->
-  Context.t -> (context * bool) tzresult Lwt.t
+  Context.t -> context tzresult Lwt.t
+
+val prepare_first_block:
+  level:int32 ->
+  timestamp:Time.t ->
+  fitness:Fitness.t ->
+  Context.t -> context tzresult Lwt.t
 
 val activate: context -> Protocol_hash.t -> t Lwt.t
 val fork_test_chain: context -> Protocol_hash.t -> Time.t -> t Lwt.t
@@ -43,9 +49,6 @@ val fork_test_chain: context -> Protocol_hash.t -> Time.t -> t Lwt.t
 val register_resolvers:
   'a Base58.encoding -> (context -> string -> 'a list Lwt.t) -> unit
 
-val configure_sandbox:
-  Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t
-
 (** Returns the state of the database resulting of operations on its
     abstract view *)
 val recover: context -> Context.t

src/proto_alpha/lib_protocol/src/services_registration.ml

@@ -20,10 +20,10 @@ type rpc_context = {
 let rpc_init (rpc_context : Updater.rpc_context Lwt.t) =
   rpc_context >>= fun { block_hash ; block_header ;
                         operation_hashes ; operations ; context } ->
-  let level = Int32.succ block_header.shell.level in
+  let level = block_header.shell.level in
   let timestamp = block_header.shell.timestamp in
   let fitness = block_header.shell.fitness in
-  Alpha_context.init ~level ~timestamp ~fitness context >>=? fun context ->
+  Alpha_context.prepare ~level ~timestamp ~fitness context >>=? fun context ->
   return { block_hash ; block_header ; operation_hashes ; operations ; context }
 
 let rpc_services = ref (RPC_directory.empty : Updater.rpc_context Lwt.t RPC_directory.t)

src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml

@@ -131,7 +131,7 @@ let get_header_hash
     shell = shell_header ;
     protocol_data = init_block.protocol_data_bytes
   } in
-  Proto_alpha.Alpha_context.init
+  Proto_alpha.Alpha_context.prepare
     validation_result.context
     ~level
     ~timestamp

src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml

@@ -21,7 +21,9 @@ let get_sandbox () =
 let main () =
   let context = Tezos_protocol_environment_memory.Context.empty in
   get_sandbox () >>= fun json ->
-  Main.configure_sandbox context @@ Some json >>=? fun context ->
+  Tezos_protocol_environment_memory.Context.set context
+    ["sandbox_parameter"]
+    (Data_encoding.Binary.to_bytes Data_encoding.json json) >>= fun context ->
   let genesis_hash =
     Block_hash.of_b58check_exn
       "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" in
@@ -40,18 +42,9 @@ let main () =
       Alpha_context.Block_header.protocol_data_encoding
       (Helpers_block.get_protocol_data 0 true) in
   let tezos_header = { Block_header.shell = header ; protocol_data } in
-  Proto_alpha.Main.begin_construction
+  Proto_alpha.init context header >>=? fun validation ->
-    ~predecessor_context: context
-    ~predecessor_fitness:[]
-    ~predecessor_timestamp:Time.epoch
-    ~predecessor_level: 0l
-    ~predecessor: genesis_hash
-    ~timestamp: header.timestamp
-    ~protocol_data
-    () >>=? fun vstate ->
   let hash = Block_header.hash tezos_header in
-  Proto_alpha.Main.finalize_block vstate >>=? fun validation ->
+  Alpha_context.prepare
-  Alpha_context.init
     ~level: (Int32.succ header.level)
     ~timestamp: header.timestamp
     ~fitness: header.fitness

src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml

@@ -14,7 +14,8 @@ open Alpha_context
 let sourced ops = Sourced_operations ops
 
 let manager (src : Helpers_account.t) ?(fee = Tez.zero) operations context =
-  Alpha_context.init ~level:0l ~timestamp:(Time.now ()) ~fitness:[] context >>=? fun context ->
+  Alpha_context.prepare
+    ~level:0l ~timestamp:(Time.now ()) ~fitness:[] context >>=? fun context ->
   Contract.get_counter context src.contract >>=? fun counter ->
   let counter = Int32.succ counter in
   return @@

src/proto_alpha/lib_protocol/test/helpers/isolate_helpers.ml

@@ -24,14 +24,14 @@ module Script = Helpers_script
 module Shorthands = struct
 
   let to_tc_full ctxt level fitness =
-    Alpha_context.init
+    Alpha_context.prepare
       ctxt
       ~level
       ~fitness
       ~timestamp:(Time.now())
 
   let get_tc_full (res:Block.result) =
-    Alpha_context.init
+    Alpha_context.prepare
       res.validation.context
       ~level:res.level
       ~timestamp:res.tezos_header.shell.timestamp

src/proto_demo/lib_protocol/src/main.ml

@@ -94,4 +94,10 @@ let finalize_block ctxt =
 
 let rpc_services = Services.rpc_services
 
-let configure_sandbox ctxt _ = Lwt.return (Ok ctxt)
+let init context block_header =
+  return { Updater.message = None ; context ;
+           fitness = block_header.Block_header.fitness ;
+           max_operations_ttl = 0 ;
+           max_operation_data_length = 0 ;
+           last_allowed_fork_level = block_header.level ;
+         }

src/proto_genesis/lib_protocol/src/data.ml

@@ -119,49 +119,21 @@ module Init = struct
      protocol.  It's absence meaning that the context is empty. *)
   let version_value = "genesis"
 
-  let may_initialize ctxt =
+  let check_inited ctxt =
+    Context.get ctxt version_key >>= function
+    | None -> failwith "Internal error: uninitialized context."
+    | Some version ->
+        if Compare.String.(version_value <> MBytes.to_string version) then
+          failwith "Internal error: incompatible protocol version" ;
+        return ()
+
+  let tag_first_block ctxt =
     Context.get ctxt version_key >>= function
     | None ->
         Context.set
           ctxt version_key (MBytes.of_string version_value) >>= fun ctxt ->
         return ctxt
-    | Some bytes ->
+    | Some _version ->
-        let s = MBytes.to_string bytes in
+        failwith "Internal error: previously initialized context." ;
-        fail_unless Compare.String.(s = version_value)
-          Incompatible_protocol_version >>=? fun () ->
-        return ctxt
-
-  let sandboxed_key = [ "v1" ; "sandboxed" ]
-
-  let set_sandboxed ctxt json =
-    Context.set ctxt sandboxed_key
-      (Data_encoding.Binary.to_bytes Data_encoding.json json)
-  let get_sandboxed ctxt =
-    Context.get ctxt sandboxed_key >>= fun b ->
-    match b with
-    | None -> return None
-    | Some b ->
-        return (Data_encoding.Binary.of_bytes Data_encoding.json b)
-
-  type error += Unimplemented_sandbox_migration
-
-  let configure_sandbox ctxt json =
-    let json =
-      match json with
-      | None -> `O []
-      | Some json -> json in
-    Context.get ctxt version_key >>= function
-    | None ->
-        set_sandboxed ctxt json >>= fun ctxt ->
-        Pubkey.may_change_default ctxt json >>= fun ctxt ->
-        return ctxt
-    | Some _ ->
-        get_sandboxed ctxt >>=? function
-        | None ->
-            fail Unimplemented_sandbox_migration
-        | Some _ ->
-            (* FIXME GRGR fail if parameter changed! *)
-            (* failwith "Changing sandbox parameter is not yet implemented" *)
-            return ctxt
 
 end

src/proto_genesis/lib_protocol/src/main.ml

@@ -109,7 +109,7 @@ let begin_application
     ~predecessor_timestamp:_
     ~predecessor_fitness:_
     raw_block =
-  Data.Init.may_initialize ctxt >>=? fun ctxt ->
+  Data.Init.check_inited ctxt >>=? fun () ->
   Lwt.return (parse_block raw_block) >>=? fun block ->
   check_signature ctxt block >>=? fun () ->
   prepare_application ctxt block.command
@@ -136,7 +136,7 @@ let begin_construction
       match Data_encoding.Binary.of_bytes Data.Command.encoding command with
       | None -> failwith "Failed to parse proto header"
       | Some command ->
-          Data.Init.may_initialize ctxt >>=? fun ctxt ->
+          Data.Init.check_inited ctxt >>=? fun () ->
           prepare_application ctxt command level timestamp fitness
 
 let apply_operation _vctxt _ =
@@ -146,4 +146,31 @@ let finalize_block state = return state
 
 let rpc_services = Services.rpc_services
 
-let configure_sandbox = Data.Init.configure_sandbox
+(* temporary hardcoded key to be removed... *)
+let sandbox_param_key = [ "sandbox_parameter" ]
+let get_sandbox_param ctxt =
+  Context.get ctxt sandbox_param_key >>= function
+  | None -> return None
+  | Some bytes ->
+      match Data_encoding.Binary.of_bytes Data_encoding.json bytes with
+      | None ->
+          failwith "Internal error: failed to parse the sandbox parameter."
+      | Some json -> return (Some json)
+
+let init ctxt block_header =
+  Data.Init.tag_first_block ctxt >>=? fun ctxt ->
+  get_sandbox_param ctxt >>=? fun sandbox_param ->
+  begin
+    match sandbox_param with
+    | None -> return ctxt
+    | Some json ->
+        Data.Pubkey.may_change_default ctxt json >>= fun ctxt ->
+        return ctxt
+  end >>=? fun ctxt ->
+  return { Updater.message = None ; context = ctxt ;
+           fitness = block_header.Block_header.fitness ;
+           max_operations_ttl = 0 ;
+           max_operation_data_length = 0 ;
+           last_allowed_fork_level = block_header.level ;
+         }
+