Verified Commit f6d67b7a authored by Alain Mebsout's avatar Alain Mebsout Committed by Marco Stronati

Alpha/Michelson: allows big maps in genesis blocks

This patch allows to create a sandbox chain with bootstrap contracts
that uses big_maps. This change is mostly useful for testing in
sandbox mode or custom deployments.

This has no effect on mainnet.
parent d0c16b4f
......@@ -1118,7 +1118,8 @@ end
val prepare_first_block:
Context.t ->
typecheck:(context -> Script.t -> context tzresult Lwt.t) ->
typecheck:(context -> Script.t ->
((Script.t * Contract.big_map_diff option) * context) tzresult Lwt.t) ->
level:Int32.t ->
timestamp:Time.t ->
fitness:Fitness.t ->
......
......@@ -466,8 +466,8 @@ let apply_manager_operation_content :
Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage)) >>=? fun ctxt ->
Script.force_decode ctxt script.code >>=? fun (unparsed_code, ctxt) -> (* see [note] *)
Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code)) >>=? fun ctxt ->
Script_ir_translator.parse_script ctxt script >>=? fun (_, ctxt) ->
Script_ir_translator.erase_big_map_initialization ctxt Optimized script >>=? fun (script, big_map_diff, ctxt) ->
Script_ir_translator.parse_script ctxt script >>=? fun (ex_script, ctxt) ->
Script_ir_translator.big_map_initialization ctxt Optimized ex_script >>=? fun (big_map_diff, ctxt) ->
return (Some (script, big_map_diff), ctxt)
end >>=? fun (script, ctxt) ->
spend ctxt source credit >>=? fun ctxt ->
......
......@@ -39,12 +39,12 @@ let init_account ctxt
let init_contract ~typecheck ctxt
({ delegate ; amount ; script }: Parameters_repr.bootstrap_contract) =
Contract_storage.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
typecheck ctxt script >>=? fun ctxt ->
typecheck ctxt script >>=? fun (script, ctxt) ->
Contract_storage.originate ctxt contract
~balance:amount
~prepaid_bootstrap_storage:true
~manager:Signature.Public_key_hash.zero
~script:(script, None)
~script
~delegate:(Some delegate)
~spendable:false
~delegatable:false >>=? fun ctxt ->
......
......@@ -25,7 +25,9 @@
val init:
Raw_context.t ->
typecheck:(Raw_context.t -> Script_repr.t -> Raw_context.t tzresult Lwt.t) ->
typecheck:(Raw_context.t -> Script_repr.t ->
((Script_repr.t * Contract_storage.big_map_diff option) * Raw_context.t)
tzresult Lwt.t) ->
?ramp_up_cycles:int ->
?no_reward_cycles:int ->
Parameters_repr.bootstrap_account list ->
......
......@@ -298,8 +298,9 @@ let init ctxt block_header =
let fitness = block_header.fitness in
let timestamp = block_header.timestamp in
let typecheck (ctxt:Alpha_context.context) (script:Alpha_context.Script.t) =
Script_ir_translator.parse_script ctxt script >>=? fun (_ex_script, ctxt) ->
return ctxt
Script_ir_translator.parse_script ctxt script >>=? fun (ex_script, ctxt) ->
Script_ir_translator.big_map_initialization ctxt Optimized ex_script >>=? fun (big_map_diff, ctxt) ->
return ((script, big_map_diff), ctxt)
in
Alpha_context.prepare_first_block
~typecheck
......
......@@ -3229,19 +3229,8 @@ let extract_big_map : type a. a ty -> a -> ex_big_map option = fun ty x ->
| Pair_t ((Big_map_t (_, _, _), _, _), _, _), (map, _) -> Some (Ex_bm map)
| _, _ -> None
let erase_big_map_initialization ctxt mode ({ code ; storage } : Script.t) =
Script.force_decode ctxt code >>=? fun (code, ctxt) ->
Script.force_decode ctxt storage >>=? fun (storage, ctxt) ->
Lwt.return @@ parse_toplevel code >>=? fun (_, storage_type, _) ->
Lwt.return @@ parse_storage_ty ctxt storage_type >>=? fun (Ex_ty ty, ctxt) ->
parse_data ctxt ty
(Micheline.root storage) >>=? fun (storage, ctxt) ->
begin
match extract_big_map ty storage with
| None -> return (None, ctxt)
| Some bm -> diff_of_big_map ctxt mode bm >>=? fun (bm, ctxt) ->
return (Some bm, ctxt)
end >>=? fun (bm, ctxt) ->
unparse_data ctxt mode ty storage >>=? fun (storage, ctxt) ->
return ({ code = Script.lazy_expr code ;
storage = Script.lazy_expr (Micheline.strip_locations storage) }, bm, ctxt)
let big_map_initialization ctxt mode (Ex_script { storage ; storage_type; _ }) =
match extract_big_map storage_type storage with
| None -> return (None, ctxt)
| Some bm ->
diff_of_big_map ctxt mode bm >>=? fun (bm, ctxt) -> return (Some bm, ctxt)
......@@ -131,6 +131,6 @@ val diff_of_big_map :
context -> unparsing_mode -> Script_typed_ir.ex_big_map ->
(Contract.big_map_diff * context) tzresult Lwt.t
val erase_big_map_initialization :
context -> unparsing_mode -> Script.t ->
(Script.t * Contract.big_map_diff option * context) tzresult Lwt.t
val big_map_initialization :
context -> unparsing_mode -> ex_script ->
(Contract.big_map_diff option * context) tzresult Lwt.t
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment