Proto/Env: Replace configure_sandbox by proper init

This commit is contained in:
Grégoire Henry 2018-04-06 11:40:34 +02:00
parent 6f0cc397ae
commit bf32659a6b
32 changed files with 268 additions and 238 deletions

View File

@ -95,4 +95,10 @@ let finalize_block ctxt =
let rpc_services = RPC_directory.empty 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 ;
}

View File

@ -11,12 +11,11 @@ activate_alpha
sleep 2 sleep 2
#tests for the rpc service raw_context #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/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=-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' $client rpc call '/blocks/head/raw_context/non-existent?depth=0' | assert 'No service found at this URL'

View File

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

View File

@ -92,32 +92,44 @@ let init_logger ?verbosity (log_config : Node_config_file.log) =
let init_node ?sandbox (config : Node_config_file.t) = let init_node ?sandbox (config : Node_config_file.t) =
let patch_context json ctxt = 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 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 begin
match sandbox with match sandbox with
| None -> Lwt.return_none | None -> Lwt.return_none
| Some sandbox_param -> | Some sandbox_param ->
match sandbox_param with match sandbox_param with
| None -> Lwt.return (Some (patch_context None)) | None -> Lwt.return None
| Some file -> | Some file ->
Lwt_utils_unix.Json.read_file file >>= function Lwt_utils_unix.Json.read_file file >>= function
| Error err -> | Error err ->
lwt_warn lwt_warn
"Can't parse sandbox parameters: %s" file >>= fun () -> "Can't parse sandbox parameters: %s" file >>= fun () ->
lwt_debug "%a" pp_print_error err >>= fun () -> lwt_debug "%a" pp_print_error err >>= fun () ->
Lwt.return (Some (patch_context None)) Lwt.return None
| Ok json -> | 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. *) (* TODO "WARN" when pow is below our expectation. *)
begin begin
match config.p2p.listen_addr with match config.p2p.listen_addr with
@ -163,7 +175,7 @@ let init_node ?sandbox (config : Node_config_file.t) =
end >>=? fun p2p_config -> end >>=? fun p2p_config ->
let node_config : Node.config = { let node_config : Node.config = {
genesis ; genesis ;
patch_context ; patch_context = Some (patch_context sandbox_param) ;
store_root = store_dir config.data_dir ; store_root = store_dir config.data_dir ;
context_root = context_dir config.data_dir ; context_root = context_dir config.data_dir ;
p2p = p2p_config ; p2p = p2p_config ;

View File

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

View File

@ -155,11 +155,12 @@ module type PROTOCOL = sig
(** The list of remote procedures exported by this implementation *) (** The list of remote procedures exported by this implementation *)
val rpc_services: rpc_context Lwt.t RPC_directory.t 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 end

View File

@ -93,8 +93,8 @@ module Make (Context : CONTEXT) = struct
val finalize_block: val finalize_block:
validation_state -> validation_result tzresult Lwt.t validation_state -> validation_result tzresult Lwt.t
val rpc_services: rpc_context Lwt.t RPC_directory.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 end
module type PROTOCOL = module type PROTOCOL =
@ -581,8 +581,7 @@ module Make (Context : CONTEXT) = struct
apply_operation c o >|= wrap_error apply_operation c o >|= wrap_error
let finalize_block c = finalize_block c >|= wrap_error let finalize_block c = finalize_block c >|= wrap_error
let parse_operation h b = parse_operation h b |> 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 end
class ['block] proto_rpc_context class ['block] proto_rpc_context

View File

@ -86,8 +86,8 @@ module Make (Context : CONTEXT) : sig
val finalize_block: val finalize_block:
validation_state -> validation_result tzresult Lwt.t validation_state -> validation_result tzresult Lwt.t
val rpc_services: rpc_context Lwt.t RPC_directory.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 end
module type PROTOCOL = module type PROTOCOL =

View File

@ -167,8 +167,8 @@ let apply_block
Proto.apply_operation state op >>=? fun state -> Proto.apply_operation state op >>=? fun state ->
return state)) return state))
state parsed_operations >>=? fun 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 = let expected_proto_level =
if Protocol_hash.equal new_protocol Proto.hash then if Protocol_hash.equal new_protocol Proto.hash then
pred_header.shell.proto_level pred_header.shell.proto_level
@ -180,19 +180,30 @@ let apply_block
expected = expected_proto_level ; expected = expected_proto_level ;
}) >>=? fun () -> }) >>=? fun () ->
fail_when fail_when
Fitness.(new_context.fitness <> header.shell.fitness) Fitness.(validation_result.fitness <> header.shell.fitness)
(invalid_block hash @@ Invalid_fitness { (invalid_block hash @@ Invalid_fitness {
expected = header.shell.fitness ; expected = header.shell.fitness ;
found = new_context.fitness ; found = validation_result.fitness ;
}) >>=? fun () -> }) >>=? 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 = let max_operations_ttl =
max 0 max 0
(min (min
((State.Block.max_operations_ttl pred)+1) ((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 check_chain_liveness chain_db hash (header: Block_header.t) =
let chain_state = Distributed_db.chain_state chain_db in let chain_state = Distributed_db.chain_state chain_db in

View File

@ -335,7 +335,6 @@ module RPC = struct
pred_shell_header.proto_level pred_shell_header.proto_level
else else
((pred_shell_header.proto_level + 1) mod 256) in ((pred_shell_header.proto_level + 1) mod 256) in
Context.commit ?message ~time:timestamp context >>= fun context ->
let shell_header : Block_header.shell_header = { let shell_header : Block_header.shell_header = {
level = Int32.succ pred_shell_header.level ; level = Int32.succ pred_shell_header.level ;
proto_level ; proto_level ;
@ -344,9 +343,22 @@ module RPC = struct
validation_passes = List.length rs ; validation_passes = List.length rs ;
operations_hash ; operations_hash ;
fitness ; fitness ;
context ; context = Context_hash.zero ; (* place holder *)
} in } 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 = let complete node ?block str =
match block with match block with

View File

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

View File

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

View File

@ -26,21 +26,18 @@ let run blkid =
in in
(* files and directories that are in context *) (* 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_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); let tests = [(("version",1), is_equal version);
(("",0), is_equal dir_depth0); (("",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); (("",-1), is_not_found);
(("not-existent",1), is_not_found); (("not-existent",1), is_not_found);
(("not-existent",0), is_not_found); (("not-existent",0), is_not_found);

View File

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

View File

@ -95,7 +95,8 @@ module Commitment = struct
include Commitment_storage include Commitment_storage
end 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 finalize ?commit_message:message c =
let fitness = Fitness.from_int64 (Fitness.current c) in 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; Raw_level.to_int32 @@ Level.last_allowed_fork_level c;
} }
let configure_sandbox = Raw_context.configure_sandbox
let activate = Raw_context.activate let activate = Raw_context.activate
let fork_test_chain = Raw_context.fork_test_chain let fork_test_chain = Raw_context.fork_test_chain

View File

@ -766,16 +766,21 @@ module Commitment : sig
end end
val init: val prepare_first_block:
Context.t -> Context.t ->
level:Int32.t -> level:Int32.t ->
timestamp:Time.t -> timestamp:Time.t ->
fitness:Fitness.t -> fitness:Fitness.t ->
context tzresult Lwt.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 activate: context -> Protocol_hash.t -> context Lwt.t
val fork_test_chain: context -> Protocol_hash.t -> Time.t -> context Lwt.t val fork_test_chain: context -> Protocol_hash.t -> Time.t -> context Lwt.t

View File

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

View File

@ -241,14 +241,18 @@ let constants_encoding =
)) ))
unit) unit)
type error += Constant_read of exn type error += Constant_read of string
let read = function let read = function
| None -> | None ->
return default return default
| Some json -> | Some json ->
match Data_encoding.Json.(destruct constants_encoding json) with 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 -> | c ->
if Compare.Int32.(c.blocks_per_roll_snapshot > c.blocks_per_cycle) then if Compare.Int32.(c.blocks_per_roll_snapshot > c.blocks_per_cycle) then
failwith "Invalid sandbox: 'blocks_per_roll_snapshot > blocks_per_cycle'" failwith "Invalid sandbox: 'blocks_per_roll_snapshot > blocks_per_cycle'"

View File

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

View File

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

View File

@ -8,7 +8,9 @@
(**************************************************************************) (**************************************************************************)
(* This is the genesis protocol: initialise the state *) (* 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 -> Roll_storage.init ctxt >>=? fun ctxt ->
Seed_storage.init ctxt >>=? fun ctxt -> Seed_storage.init ctxt >>=? fun ctxt ->
Contract_storage.init ctxt >>=? fun ctxt -> Contract_storage.init ctxt >>=? fun ctxt ->
@ -18,10 +20,5 @@ let initialize ctxt =
Commitment_storage.init ctxt >>=? fun ctxt -> Commitment_storage.init ctxt >>=? fun ctxt ->
return 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

View File

@ -69,7 +69,7 @@ let begin_application
let level = block_header.shell.level in let level = block_header.shell.level in
let fitness = pred_fitness in let fitness = pred_fitness in
let timestamp = block_header.shell.timestamp 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 Apply.begin_application
ctxt block_header pred_timestamp >>=? fun (ctxt, baker, deposit) -> ctxt block_header pred_timestamp >>=? fun (ctxt, baker, deposit) ->
let mode = Application { block_header ; baker = Ed25519.Public_key.hash baker } in 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 level = Int32.succ pred_level in
let fitness = pred_fitness 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 begin
match protocol_data with match protocol_data with
| None -> | None ->
@ -153,4 +153,10 @@ let finalize_block { mode ; ctxt ; op_count ; deposit ; fees ; rewards } =
let compare_operations op1 op2 = let compare_operations op1 op2 =
Apply.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)

View File

@ -120,22 +120,12 @@ let storage_error err = fail (Storage_error err)
let version_key = ["version"] let version_key = ["version"]
let version_value = "alpha" 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 version = "v1"
let first_level_key = [ version ; "first_level" ] 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 = let get_first_level ctxt =
Context.get ctxt first_level_key >>= function Context.get ctxt first_level_key >>= function
@ -171,35 +161,49 @@ let () =
(function Failed_to_parse_sandbox_parameter data -> Some data | _ -> None) (function Failed_to_parse_sandbox_parameter data -> Some data | _ -> None)
(fun data -> Failed_to_parse_sandbox_parameter data) (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 | None -> return None
| Some bytes -> | Some bytes ->
match Data_encoding.Binary.of_bytes Data_encoding.json bytes with match Data_encoding.Binary.of_bytes Data_encoding.json bytes with
| None -> fail (Failed_to_parse_sandbox_parameter bytes) | None -> fail (Failed_to_parse_sandbox_parameter bytes)
| Some json -> return (Some json) | 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 = let prepare ~level ~timestamp ~fitness ctxt =
Lwt.return (Raw_level_repr.of_int32 level ) >>=? fun level -> Lwt.return (Raw_level_repr.of_int32 level) >>=? fun level ->
Lwt.return (Fitness_repr.to_int64 fitness) >>=? fun fitness -> 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 = let level =
Level_repr.from_raw Level_repr.from_raw
~first_level ~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_voting_period:constants.Constants_repr.blocks_per_voting_period
~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
level in level in
return ({ context = ctxt ; constants ; level ; return {
context = ctxt ; constants ; level ;
timestamp ; fitness ; first_level ; timestamp ; fitness ; first_level ;
endorsements_received = Int_set.empty ; 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 = let activate ({ context = c ; _ } as s) h =
Updater.activate c h >>= fun c -> Lwt.return { s with context = c } 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 resolve faked_context str in
Context.register_resolver enc resolve 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 ********************************************************) (* Generic context ********************************************************)
type key = string list type key = string list

View File

@ -35,7 +35,13 @@ val prepare:
level: Int32.t -> level: Int32.t ->
timestamp: Time.t -> timestamp: Time.t ->
fitness: Fitness.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 activate: context -> Protocol_hash.t -> t Lwt.t
val fork_test_chain: context -> Protocol_hash.t -> Time.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: val register_resolvers:
'a Base58.encoding -> (context -> string -> 'a list Lwt.t) -> unit '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 (** Returns the state of the database resulting of operations on its
abstract view *) abstract view *)
val recover: context -> Context.t val recover: context -> Context.t

View File

@ -20,10 +20,10 @@ type rpc_context = {
let rpc_init (rpc_context : Updater.rpc_context Lwt.t) = let rpc_init (rpc_context : Updater.rpc_context Lwt.t) =
rpc_context >>= fun { block_hash ; block_header ; rpc_context >>= fun { block_hash ; block_header ;
operation_hashes ; operations ; context } -> 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 timestamp = block_header.shell.timestamp in
let fitness = block_header.shell.fitness 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 } return { block_hash ; block_header ; operation_hashes ; operations ; context }
let rpc_services = ref (RPC_directory.empty : Updater.rpc_context Lwt.t RPC_directory.t) let rpc_services = ref (RPC_directory.empty : Updater.rpc_context Lwt.t RPC_directory.t)

View File

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

View File

@ -21,7 +21,9 @@ let get_sandbox () =
let main () = let main () =
let context = Tezos_protocol_environment_memory.Context.empty in let context = Tezos_protocol_environment_memory.Context.empty in
get_sandbox () >>= fun json -> 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 = let genesis_hash =
Block_hash.of_b58check_exn Block_hash.of_b58check_exn
"BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" in "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" in
@ -40,18 +42,9 @@ let main () =
Alpha_context.Block_header.protocol_data_encoding Alpha_context.Block_header.protocol_data_encoding
(Helpers_block.get_protocol_data 0 true) in (Helpers_block.get_protocol_data 0 true) in
let tezos_header = { Block_header.shell = header ; protocol_data } 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 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) ~level: (Int32.succ header.level)
~timestamp: header.timestamp ~timestamp: header.timestamp
~fitness: header.fitness ~fitness: header.fitness

View File

@ -14,7 +14,8 @@ open Alpha_context
let sourced ops = Sourced_operations ops let sourced ops = Sourced_operations ops
let manager (src : Helpers_account.t) ?(fee = Tez.zero) operations context = 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 -> Contract.get_counter context src.contract >>=? fun counter ->
let counter = Int32.succ counter in let counter = Int32.succ counter in
return @@ return @@

View File

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

View File

@ -94,4 +94,10 @@ let finalize_block ctxt =
let rpc_services = Services.rpc_services 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 ;
}

View File

@ -119,49 +119,21 @@ module Init = struct
protocol. It's absence meaning that the context is empty. *) protocol. It's absence meaning that the context is empty. *)
let version_value = "genesis" 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 Context.get ctxt version_key >>= function
| None -> | None ->
Context.set Context.set
ctxt version_key (MBytes.of_string version_value) >>= fun ctxt -> ctxt version_key (MBytes.of_string version_value) >>= fun ctxt ->
return 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 end

View File

@ -109,7 +109,7 @@ let begin_application
~predecessor_timestamp:_ ~predecessor_timestamp:_
~predecessor_fitness:_ ~predecessor_fitness:_
raw_block = raw_block =
Data.Init.may_initialize ctxt >>=? fun ctxt -> Data.Init.check_inited ctxt >>=? fun () ->
Lwt.return (parse_block raw_block) >>=? fun block -> Lwt.return (parse_block raw_block) >>=? fun block ->
check_signature ctxt block >>=? fun () -> check_signature ctxt block >>=? fun () ->
prepare_application ctxt block.command prepare_application ctxt block.command
@ -136,7 +136,7 @@ let begin_construction
match Data_encoding.Binary.of_bytes Data.Command.encoding command with match Data_encoding.Binary.of_bytes Data.Command.encoding command with
| None -> failwith "Failed to parse proto header" | None -> failwith "Failed to parse proto header"
| Some command -> | Some command ->
Data.Init.may_initialize ctxt >>=? fun ctxt -> Data.Init.check_inited ctxt >>=? fun () ->
prepare_application ctxt command level timestamp fitness prepare_application ctxt command level timestamp fitness
let apply_operation _vctxt _ = let apply_operation _vctxt _ =
@ -146,4 +146,31 @@ let finalize_block state = return state
let rpc_services = Services.rpc_services 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 ;
}