balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Alpha: thread origination_nonce in the context

Browse Source
This commit is contained in:
Benjamin Canou 2018-04-15 23:57:28 +02:00 committed by Grégoire Henry
parent f05b02f74f
commit 18c77318fb
14 changed files with 271 additions and 252 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/proto_alpha/lib_protocol/src/alpha_context.ml
View File

@ -76,6 +76,8 @@ end
module Contract = struct
include Contract_repr
include Contract_storage
let init_origination_nonce = Raw_context.init_origination_nonce
let unset_origination_nonce = Raw_context.unset_origination_nonce
end
module Delegate = Delegate_storage
module Roll = struct

15
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

@ -485,14 +485,6 @@ module Contract : sig
val list: context -> contract list Lwt.t
type origination_nonce
val origination_nonce_encoding: origination_nonce Data_encoding.t
val originated_contract: origination_nonce -> contract
val originated_contracts: origination_nonce -> contract list
val initial_origination_nonce: Operation_hash.t -> origination_nonce
val get_manager:
context -> contract -> public_key_hash tzresult Lwt.t
@ -517,17 +509,20 @@ module Contract : sig
val get_balance:
context -> contract -> Tez.t tzresult Lwt.t
val init_origination_nonce: context -> Operation_hash.t -> context
val unset_origination_nonce: context -> context
val originated_from_current_nonce: context -> contract list tzresult Lwt.t
type big_map_diff = (string * Script.expr option) list
val originate:
context ->
origination_nonce ->
balance: Tez.t ->
manager: public_key_hash ->
?script: (Script.t * big_map_diff option) ->
delegate: public_key_hash option ->
spendable: bool ->
delegatable: bool -> (context * contract * origination_nonce) tzresult Lwt.t
delegatable: bool -> (context * contract) tzresult Lwt.t
type error += Balance_too_low of contract * Tez.t * Tez.t

114
src/proto_alpha/lib_protocol/src/apply.ml
View File

@ -369,8 +369,8 @@ let apply_amendment_operation_content ctxt delegate = function
Amendment.record_ballot ctxt delegate proposal ballot
let apply_manager_operation_content
ctxt origination_nonce ~payer ~source ~internal = function
| Reveal _ -> return (ctxt, origination_nonce, None, Tez.zero, [])
ctxt ~payer ~source ~internal = function
| Reveal _ -> return (ctxt, None, Tez.zero, [])
| Transaction { amount ; parameters ; destination } ->
begin
begin
@ -384,28 +384,28 @@ let apply_manager_operation_content
| None -> begin
match parameters with
| None ->
return (ctxt, origination_nonce, None, Tez.zero, [])
return (ctxt, None, Tez.zero, [])
| Some arg ->
match Micheline.root arg with
| Prim (_, D_Unit, [], _) ->
return (ctxt, origination_nonce, None, Tez.zero, [])
return (ctxt, None, Tez.zero, [])
| _ -> fail (Bad_contract_parameter (destination, None, parameters))
end
| Some script ->
let call_contract ctxt parameter =
Script_interpreter.execute
ctxt origination_nonce
ctxt
~check_operations:(not internal)
~source ~payer ~self:(destination, script) ~amount ~parameter
>>= function
| Ok { ctxt ; origination_nonce ; storage ; big_map_diff ; operations } ->
| Ok { ctxt ; storage ; big_map_diff ; operations } ->
Contract.update_script_storage
ctxt destination storage big_map_diff >>=? fun ctxt ->
Fees.update_script_storage
ctxt ~payer destination >>=? fun (ctxt, fees) ->
return (ctxt, origination_nonce, None, fees, operations)
return (ctxt, None, fees, operations)
| Error err ->
return (ctxt, origination_nonce, Some err, Tez.zero, []) in
return (ctxt, Some err, Tez.zero, []) in
Lwt.return @@ Script_ir_translator.parse_toplevel script.code >>=? fun (arg_type, _, _) ->
let arg_type = Micheline.strip_locations arg_type in
match parameters, Micheline.root arg_type with
@ -416,7 +416,7 @@ let apply_manager_operation_content
| Ok ctxt -> call_contract ctxt parameters
| Error errs ->
let err = Bad_contract_parameter (destination, Some arg_type, Some parameters) in
return (ctxt, origination_nonce, Some ((err :: errs)), Tez.zero, [])
return (ctxt, Some ((err :: errs)), Tez.zero, [])
end
| None, _ -> fail (Bad_contract_parameter (destination, Some arg_type, None))
end
@ -431,59 +431,58 @@ let apply_manager_operation_content
end >>=? fun (script, ctxt) ->
Contract.spend ctxt source credit >>=? fun ctxt ->
Contract.originate ctxt
origination_nonce
~manager ~delegate ~balance:credit
?script
~spendable ~delegatable >>=? fun (ctxt, contract, origination_nonce) ->
~spendable ~delegatable >>=? fun (ctxt, contract) ->
Fees.origination_burn ctxt ~payer contract >>=? fun ctxt ->
return (ctxt, origination_nonce, None, Tez.zero, [])
return (ctxt, None, Tez.zero, [])
| Delegation delegate ->
Delegate.set ctxt source delegate >>=? fun ctxt ->
return (ctxt, origination_nonce, None, Tez.zero, [])
return (ctxt, None, Tez.zero, [])
let apply_internal_manager_operations ctxt origination_nonce ~payer ops =
let rec apply ctxt origination_nonce storage_fees applied worklist =
let apply_internal_manager_operations ctxt ~payer ops =
let rec apply ctxt storage_fees applied worklist =
match worklist with
| [] -> return (ctxt, origination_nonce, None, storage_fees, List.rev applied)
| [] -> return (ctxt, None, storage_fees, List.rev applied)
| { source ; operation ;
signature = _ (* at this point the signature must have been
checked if the operation has been
deserialized from the outside world *) } as op :: rest ->
apply_manager_operation_content ctxt origination_nonce ~source ~payer ~internal:true operation
>>=? fun (ctxt, origination_nonce, ignored_error, operation_storage_fees, emitted) ->
apply_manager_operation_content ctxt ~source ~payer ~internal:true operation
>>=? fun (ctxt, ignored_error, operation_storage_fees, emitted) ->
Lwt.return Tez.(storage_fees +? operation_storage_fees) >>=? fun storage_fees ->
match ignored_error with
| Some err ->
return (ctxt, origination_nonce, Some err, storage_fees, List.rev (op :: applied))
return (ctxt, Some err, storage_fees, List.rev (op :: applied))
| None ->
apply ctxt origination_nonce storage_fees (op :: applied) (rest @ emitted) in
apply ctxt origination_nonce Tez.zero [] ops
apply ctxt storage_fees (op :: applied) (rest @ emitted) in
apply ctxt Tez.zero [] ops
let apply_manager_operations ctxt origination_nonce source ops =
let rec apply ctxt origination_nonce storage_fees applied ops =
let apply_manager_operations ctxt source ops =
let rec apply ctxt storage_fees applied ops =
match ops with
| [] -> return (ctxt, origination_nonce, None, storage_fees, List.rev applied)
| [] -> return (ctxt, None, storage_fees, List.rev applied)
| operation :: rest ->
Contract.must_exist ctxt source >>=? fun () ->
apply_manager_operation_content ctxt origination_nonce ~source ~payer:source ~internal:false operation
>>=? fun (ctxt, origination_nonce, ignored_error, operation_storage_fees, emitted) ->
apply_manager_operation_content ctxt ~source ~payer:source ~internal:false operation
>>=? fun (ctxt, ignored_error, operation_storage_fees, emitted) ->
Lwt.return Tez.(storage_fees +? operation_storage_fees) >>=? fun storage_fees ->
let op = { source ; operation ; signature = None } in
match ignored_error with
| Some _ -> return (ctxt, origination_nonce, ignored_error, storage_fees, List.rev (op :: applied))
| Some _ -> return (ctxt, ignored_error, storage_fees, List.rev (op :: applied))
| None ->
apply_internal_manager_operations ctxt origination_nonce ~payer:source emitted
>>=? fun (ctxt, origination_nonce, ignored_error, internal_storage_fees, internal_applied) ->
apply_internal_manager_operations ctxt ~payer:source emitted
>>=? fun (ctxt, ignored_error, internal_storage_fees, internal_applied) ->
let applied = List.rev internal_applied @ (op :: applied) in
Lwt.return Tez.(storage_fees +? internal_storage_fees) >>=? fun storage_fees ->
match ignored_error with
| Some _ -> return (ctxt, origination_nonce, ignored_error, storage_fees, List.rev applied)
| None -> apply ctxt origination_nonce storage_fees applied rest in
apply ctxt origination_nonce Tez.zero [] ops
| Some _ -> return (ctxt, ignored_error, storage_fees, List.rev applied)
| None -> apply ctxt storage_fees applied rest in
apply ctxt Tez.zero [] ops
let apply_sourced_operation
ctxt pred_block block_prio
operation origination_nonce ops =
operation ops =
match ops with
| Manager_operations { source ; fee ; counter ; operations ; gas_limit } ->
let revealed_public_keys =
@ -507,34 +506,34 @@ let apply_sourced_operation
Contract.spend ctxt source fee >>=? fun ctxt ->
add_fees ctxt fee >>=? fun ctxt ->
Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
apply_manager_operations ctxt origination_nonce source operations
>>=? fun (ctxt, origination_nonce, ignored_error, storage_fees, applied) ->
return (ctxt, origination_nonce, ignored_error, storage_fees, applied)
apply_manager_operations ctxt source operations
>>=? fun (ctxt, ignored_error, storage_fees, applied) ->
return (ctxt, ignored_error, storage_fees, applied)
| Consensus_operation content ->
apply_consensus_operation_content ctxt
pred_block block_prio operation content >>=? fun ctxt ->
return (ctxt, origination_nonce, None, Tez.zero, [])
return (ctxt, None, Tez.zero, [])
| Amendment_operation { source ; operation = content } ->
Roll.delegate_pubkey ctxt source >>=? fun delegate ->
Operation.check_signature delegate operation >>=? fun () ->
(* TODO, see how to extract the public key hash after this operation to
pass it to apply_delegate_operation_content *)
apply_amendment_operation_content ctxt source content >>=? fun ctxt ->
return (ctxt, origination_nonce, None, Tez.zero, [])
return (ctxt, None, Tez.zero, [])
| Dictator_operation (Activate hash) ->
let dictator_pubkey = Constants.dictator_pubkey ctxt in
Operation.check_signature dictator_pubkey operation >>=? fun () ->
activate ctxt hash >>= fun ctxt ->
return (ctxt, origination_nonce, None, Tez.zero, [])
return (ctxt, None, Tez.zero, [])
| Dictator_operation (Activate_testchain hash) ->
let dictator_pubkey = Constants.dictator_pubkey ctxt in
Operation.check_signature dictator_pubkey operation >>=? fun () ->
let expiration = (* in two days maximum... *)
Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in
fork_test_chain ctxt hash expiration >>= fun ctxt ->
return (ctxt, origination_nonce, None, Tez.zero, [])
return (ctxt, None, Tez.zero, [])
let apply_anonymous_operation ctxt _delegate origination_nonce kind =
let apply_anonymous_operation ctxt _delegate kind =
match kind with
| Seed_nonce_revelation { level ; nonce } ->
let level = Level.from_raw ctxt level in
@ -542,7 +541,7 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
let seed_nonce_revelation_tip =
Constants.seed_nonce_revelation_tip ctxt in
add_rewards ctxt seed_nonce_revelation_tip >>=? fun ctxt ->
return (ctxt, origination_nonce)
return ctxt
| Double_endorsement_evidence { op1 ; op2 } -> begin
match op1.contents, op2.contents with
| Sourced_operations (Consensus_operation (Endorsements e1)),
@ -581,7 +580,7 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
| Ok v -> v
| Error _ -> Tez.zero in
add_rewards ctxt reward >>=? fun ctxt ->
return (ctxt, origination_nonce)
return ctxt
| _, _ -> fail Invalid_double_endorsement_evidence
end
| Double_baking_evidence { bh1 ; bh2 } ->
@ -620,7 +619,7 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
| Ok v -> v
| Error _ -> Tez.zero in
add_rewards ctxt reward >>=? fun ctxt ->
return (ctxt, origination_nonce)
return ctxt
| Activation { id = pkh ; secret } ->
let h_pkh = Unclaimed_public_key_hash.of_ed25519_pkh pkh in
Commitment.get_opt ctxt h_pkh >>=? function
@ -632,12 +631,12 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
Wrong_activation_secret >>=? fun () ->
Commitment.delete ctxt h_pkh >>=? fun ctxt ->
Contract.(credit ctxt (implicit_contract (Signature.Ed25519 pkh)) amount) >>=? fun ctxt ->
return (ctxt, origination_nonce)
return ctxt
type operation_result =
{ ctxt : context ;
gas : Gas.t ;
origination_nonce : Contract.origination_nonce ;
contracts : Contract.t list ;
ignored_error : error list option ;
internal_operations : internal_operation list ;
fees : Tez.t ;
@ -646,25 +645,26 @@ type operation_result =
let apply_operation
ctxt delegate pred_block block_prio hash operation =
let ctxt = Contract.init_origination_nonce ctxt hash in
begin match operation.contents with
| Anonymous_operations ops ->
let origination_nonce = Contract.initial_origination_nonce hash in
fold_left_s
(fun (ctxt, origination_nonce) op ->
apply_anonymous_operation ctxt delegate origination_nonce op)
(ctxt, origination_nonce) ops
>>=? fun (ctxt, origination_nonce) ->
return (ctxt, origination_nonce, None, Tez.zero, [])
(fun ctxt op ->
apply_anonymous_operation ctxt delegate op)
ctxt ops
>>=? fun ctxt ->
return (ctxt, None, Tez.zero, [])
| Sourced_operations op ->
let origination_nonce = Contract.initial_origination_nonce hash in
apply_sourced_operation
ctxt pred_block block_prio
operation origination_nonce op
end >>=? fun (ctxt, origination_nonce, ignored_error, storage_fees, internal_operations) ->
operation op
end >>=? fun (ctxt, ignored_error, storage_fees, internal_operations) ->
let gas = Gas.level ctxt in
let ctxt = Gas.set_unlimited ctxt in
return { ctxt ; gas ; origination_nonce ; ignored_error ; storage_fees ;
internal_operations ;
Contract.originated_from_current_nonce ctxt >>=? fun contracts ->
let ctxt = Contract.unset_origination_nonce ctxt in
return { ctxt ; gas ; ignored_error ; storage_fees ;
internal_operations ; contracts ;
fees = Alpha_context.get_fees ctxt ;
rewards = Alpha_context.get_rewards ctxt }

11
src/proto_alpha/lib_protocol/src/contract_storage.ml
View File

@ -243,10 +243,11 @@ let create_base c contract
return c) >>=? fun c ->
return (c, contract)
let originate c nonce ~balance ~manager ?script ~delegate ~spendable ~delegatable =
let originate c ~balance ~manager ?script ~delegate ~spendable ~delegatable =
Lwt.return (Raw_context.increment_origination_nonce c) >>=? fun (c, nonce) ->
let contract = Contract_repr.originated_contract nonce in
create_base c contract ~balance ~manager ~delegate ?script ~spendable ~delegatable >>=? fun (ctxt, contract) ->
return (ctxt, contract, Contract_repr.incr_origination_nonce nonce)
return (ctxt, contract)
let create_implicit c manager ~balance =
create_base c (Contract_repr.implicit_contract manager)
@ -292,6 +293,12 @@ let must_be_allocated c contract =
let list c = Storage.Contract.list c
let originated_from_current_nonce ctxt =
Lwt.return (Raw_context.origination_nonce ctxt) >>=? fun nonce ->
let contracts = Contract_repr.originated_contracts nonce in
iter_s (fun contract -> must_exist ctxt contract) contracts >>=? fun () ->
return contracts
let check_counter_increment c contract counter =
Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
let expected = Int32.succ contract_counter in

7
src/proto_alpha/lib_protocol/src/contract_storage.mli
View File

@ -83,14 +83,17 @@ val spend_from_script:
val originate:
Raw_context.t ->
Contract_repr.origination_nonce ->
balance:Tez_repr.t ->
manager:Signature.Public_key_hash.t ->
?script:(Script_repr.t * big_map_diff option) ->
delegate:Signature.Public_key_hash.t option ->
spendable:bool ->
delegatable:bool ->
(Raw_context.t * Contract_repr.t * Contract_repr.origination_nonce) tzresult Lwt.t
(Raw_context.t * Contract_repr.t) tzresult Lwt.t
val originated_from_current_nonce :
Raw_context.t -> Contract_repr.t list tzresult Lwt.t
val init:
Raw_context.t -> Raw_context.t tzresult Lwt.t

50
src/proto_alpha/lib_protocol/src/helpers_services.ml
View File

@ -24,13 +24,12 @@ module S = struct
RPC_path.(custom_root / "minimal_timestamp")
let run_code_input_encoding =
(obj6
(obj5
(req "script" Script.expr_encoding)
(req "storage" Script.expr_encoding)
(req "input" Script.expr_encoding)
(req "amount" Tez.encoding)
(req "contract" Contract.encoding)
(opt "origination_nonce" Contract.origination_nonce_encoding))
(req "contract" Contract.encoding))
let run_code =
RPC_service.post_service
@ -153,22 +152,9 @@ module I = struct
ctxt (Some baker_pkh) pred_block block_prio hash operation
>>=? function
| { ignored_error = Some script_err ; _ } -> Lwt.return (Error script_err)
| { gas ; origination_nonce ; internal_operations ; _ } ->
let contracts = Contract.originated_contracts origination_nonce in
| { gas ; contracts ; internal_operations ; _ } ->
Lwt.return (Ok (contracts, internal_operations, gas))
let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) =
let max_gas =
Constants.hard_gas_limit_per_operation ctxt in
let origination_nonce =
match origination_nonce with
| Some origination_nonce -> origination_nonce
| None ->
Contract.initial_origination_nonce
(Operation_hash.hash_string [ "FAKE " ; "FAKE" ; "FAKE" ]) in
(script, storage, input, amount, contract, max_gas, origination_nonce)
end
let () =
@ -179,15 +165,12 @@ let () =
Baking.minimal_time ctxt slot timestamp
end ;
register0 S.apply_operation I.apply_operation ;
register0 S.run_code begin fun ctxt () parameters ->
let (code, storage, parameter, amount, contract, gas, origination_nonce) =
I.run_parameters ctxt parameters in
begin if Compare.Z.(gas > Z.zero) then
Lwt.return (Gas.set_limit ctxt gas)
else
return (Gas.set_unlimited ctxt) end >>=? fun ctxt ->
register0 S.run_code begin fun ctxt ()
(code, storage, parameter, amount, contract) ->
Lwt.return (Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt)) >>=? fun ctxt ->
let ctxt = Contract.init_origination_nonce ctxt Operation_hash.zero in
Script_interpreter.execute
ctxt origination_nonce
ctxt
~check_operations:true
~source:contract (* transaction initiator *)
~payer:contract (* storage fees payer *)
@ -196,15 +179,12 @@ let () =
>>=? fun { Script_interpreter.storage ; operations ; big_map_diff ; _ } ->
return (storage, operations, big_map_diff)
end ;
register0 S.trace_code begin fun ctxt () parameters ->
let (code, storage, parameter, amount, contract, gas, origination_nonce) =
I.run_parameters ctxt parameters in
begin if Compare.Z.(gas > Z.zero) then
Lwt.return (Gas.set_limit ctxt gas)
else
return (Gas.set_unlimited ctxt) end >>=? fun ctxt ->
register0 S.trace_code begin fun ctxt ()
(code, storage, parameter, amount, contract) ->
Lwt.return (Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt)) >>=? fun ctxt ->
let ctxt = Contract.init_origination_nonce ctxt Operation_hash.zero in
Script_interpreter.trace
ctxt origination_nonce
ctxt
~check_operations:true
~source:contract (* transaction initiator *)
~payer:contract (* storage fees payer *)
@ -252,7 +232,7 @@ let minimal_time ctxt ?priority block =
let run_code ctxt block code (storage, input, amount, contract) =
RPC_context.make_call0 S.run_code ctxt
block () (code, storage, input, amount, contract, None)
block () (code, storage, input, amount, contract)
let apply_operation ctxt block pred_block hash forged_operation signature =
RPC_context.make_call0 S.apply_operation ctxt
@ -260,7 +240,7 @@ let apply_operation ctxt block pred_block hash forged_operation signature =
let trace_code ctxt block code (storage, input, amount, contract) =
RPC_context.make_call0 S.trace_code ctxt
block () (code, storage, input, amount, contract, None)
block () (code, storage, input, amount, contract)
let typecheck_code ctxt block =
RPC_context.make_call0 S.typecheck_code ctxt block ()

38
src/proto_alpha/lib_protocol/src/raw_context.ml
View File

@ -21,6 +21,7 @@ type t = {
rewards: Tez_repr.t ;
block_gas: Z.t ;
operation_gas: Gas_repr.t ;
origination_nonce: Contract_repr.origination_nonce option ;
}
type context = t
@ -49,6 +50,41 @@ let add_rewards ctxt rewards =
let get_rewards ctxt = ctxt.rewards
let get_fees ctxt = ctxt.fees
type error += Undefined_operation_nonce (* `Permanent *)
let () =
let open Data_encoding in
register_error_kind
`Permanent
~id:"undefined_operation_nonce"
~title: "Ill timed access to the origination nonce"
~description:
"An origination was attemped out of the scope of a manager operation"
empty
(function Undefined_operation_nonce -> Some () | _ -> None)
(fun () -> Undefined_operation_nonce)
let init_origination_nonce ctxt operation_hash =
let origination_nonce =
Some (Contract_repr.initial_origination_nonce operation_hash) in
{ ctxt with origination_nonce }
let origination_nonce ctxt =
match ctxt.origination_nonce with
| None -> error Undefined_operation_nonce
| Some origination_nonce -> ok origination_nonce
let increment_origination_nonce ctxt =
match ctxt.origination_nonce with
| None -> error Undefined_operation_nonce
| Some cur_origination_nonce ->
let origination_nonce =
Some (Contract_repr.incr_origination_nonce cur_origination_nonce) in
ok ({ ctxt with origination_nonce }, cur_origination_nonce)
let unset_origination_nonce ctxt =
{ ctxt with origination_nonce = None }
type error += Gas_limit_too_high (* `Permanent *)
let () =
@ -295,6 +331,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
rewards = Tez_repr.zero ;
operation_gas = Unaccounted ;
block_gas = constants.Constants_repr.hard_gas_limit_per_block ;
origination_nonce = None ;
}
let check_first_block ctxt =
@ -341,6 +378,7 @@ let register_resolvers enc resolve =
rewards = Tez_repr.zero ;
block_gas = Constants_repr.default.hard_gas_limit_per_block ;
operation_gas = Unaccounted ;
origination_nonce = None ;
} in
resolve faked_context str in
Context.register_resolver enc resolve

7
src/proto_alpha/lib_protocol/src/raw_context.mli
View File

@ -82,6 +82,13 @@ val set_gas_unlimited: t -> t
val gas_level: t -> Gas_repr.t
val block_gas_level: t -> Z.t
type error += Undefined_operation_nonce (* `Permanent *)
val init_origination_nonce: t -> Operation_hash.t -> t
val origination_nonce: t -> Contract_repr.origination_nonce tzresult
val increment_origination_nonce: t -> (t * Contract_repr.origination_nonce) tzresult
val unset_origination_nonce: t -> t
(** {1 Generic accessors} *************************************************)
type key = string list

257
src/proto_alpha/lib_protocol/src/script_interpreter.ml
View File

@ -81,60 +81,56 @@ type execution_trace =
let rec interp
: type p r.
(?log: execution_trace ref ->
context -> Contract.origination_nonce ->
context ->
source: Contract.t -> payer:Contract.t -> self: Contract.t -> Tez.t ->
(p, r) lambda -> p ->
(r * context * Contract.origination_nonce) tzresult Lwt.t)
= fun ?log ctxt origination ~source ~payer ~self amount (Lam (code, _)) arg ->
(r * context) tzresult Lwt.t)
= fun ?log ctxt ~source ~payer ~self amount (Lam (code, _)) arg ->
let rec step
: type b a.
Contract.origination_nonce -> context -> (b, a) descr -> b stack ->
(a stack * context * Contract.origination_nonce) tzresult Lwt.t =
fun origination ctxt ({ instr ; loc ; _ } as descr) stack ->
context -> (b, a) descr -> b stack ->
(a stack * context) tzresult Lwt.t =
fun ctxt ({ instr ; loc ; _ } as descr) stack ->
Lwt.return (Gas.consume ctxt Interp_costs.cycle) >>=? fun ctxt ->
let logged_return : type a b.
(b, a) descr ->
?origination:Contract.origination_nonce ->
a stack * context ->
(a stack * context * Contract.origination_nonce) tzresult Lwt.t =
fun descr ?(origination = origination) (ret, ctxt) ->
(a stack * context) tzresult Lwt.t =
fun descr (ret, ctxt) ->
match log with
| None -> return (ret, ctxt, origination)
| None -> return (ret, ctxt)
| Some log ->
log := (descr.loc, Gas.level ctxt, unparse_stack ctxt (ret, descr.aft)) :: !log ;
return (ret, ctxt, origination) in
return (ret, ctxt) in
let consume_gas_terop : type ret arg1 arg2 arg3 rest.
?origination:Contract.origination_nonce ->
(_ * (_ * (_ * rest)), ret * rest) descr ->
((arg1 -> arg2 -> arg3 -> ret) * arg1 * arg2 * arg3) ->
(arg1 -> arg2 -> arg3 -> Gas.cost) ->
rest stack ->
((ret * rest) stack * context * Contract.origination_nonce) tzresult Lwt.t =
fun ?(origination = origination) descr (op, x1, x2, x3) cost_func rest ->
((ret * rest) stack * context) tzresult Lwt.t =
fun descr (op, x1, x2, x3) cost_func rest ->
Lwt.return (Gas.consume ctxt (cost_func x1 x2 x3)) >>=? fun ctxt ->
logged_return descr ~origination (Item (op x1 x2 x3, rest), ctxt) in
logged_return descr (Item (op x1 x2 x3, rest), ctxt) in
let consume_gas_binop : type ret arg1 arg2 rest.
?origination:Contract.origination_nonce ->
(_ * (_ * rest), ret * rest) descr ->
((arg1 -> arg2 -> ret) * arg1 * arg2) ->
(arg1 -> arg2 -> Gas.cost) ->
rest stack ->
context ->
((ret * rest) stack * context * Contract.origination_nonce) tzresult Lwt.t =
fun ?(origination = origination) descr (op, x1, x2) cost_func rest ctxt ->
((ret * rest) stack * context) tzresult Lwt.t =
fun descr (op, x1, x2) cost_func rest ctxt ->
Lwt.return (Gas.consume ctxt (cost_func x1 x2)) >>=? fun ctxt ->
logged_return descr ~origination (Item (op x1 x2, rest), ctxt) in
logged_return descr (Item (op x1 x2, rest), ctxt) in
let consume_gas_unop : type ret arg rest.
?origination:Contract.origination_nonce ->
(_ * rest, ret * rest) descr ->
((arg -> ret) * arg) ->
(arg -> Gas.cost) ->
rest stack ->
context ->
((ret * rest) stack * context * Contract.origination_nonce) tzresult Lwt.t =
fun ?(origination = origination) descr (op, arg) cost_func rest ctxt ->
((ret * rest) stack * context) tzresult Lwt.t =
fun descr (op, arg) cost_func rest ctxt ->
Lwt.return (Gas.consume ctxt (cost_func arg)) >>=? fun ctxt ->
logged_return descr ~origination (Item (op arg, rest), ctxt) in
logged_return descr (Item (op arg, rest), ctxt) in
let consume_gaz_comparison :
type t rest.
(t * (t * rest), Script_int.z Script_int.num * rest) descr ->
@ -142,9 +138,7 @@ let rec interp
(t -> t -> Gas.cost) ->
t -> t ->
rest stack ->
((Script_int.z Script_int.num * rest) stack
* context
* Contract.origination_nonce) tzresult Lwt.t =
((Script_int.z Script_int.num * rest) stack * context) tzresult Lwt.t =
fun descr op cost x1 x2 rest ->
Lwt.return (Gas.consume ctxt (cost x1 x2)) >>=? fun ctxt ->
logged_return descr (Item (Script_int.of_int @@ op x1 x2, rest), ctxt) in
@ -155,7 +149,7 @@ let rec interp
delegatable:bool -> credit:Tez.t -> code:prim Micheline.canonical ->
init:storage -> param_type:param ty -> storage_type:storage ty ->
rest:rest stack ->
((param typed_contract * rest) stack * context * Contract.origination_nonce) tzresult Lwt.t =
((param typed_contract * rest) stack * context) tzresult Lwt.t =
fun descr ~manager ~delegate ~spendable ~delegatable
~credit ~code ~init ~param_type ~storage_type ~rest ->
Lwt.return (Gas.consume ctxt Interp_costs.create_contract) >>=? fun ctxt ->
@ -168,16 +162,15 @@ let rec interp
let storage = Micheline.strip_locations storage in
Contract.spend_from_script ctxt self credit >>=? fun ctxt ->
Contract.originate ctxt
origination
~manager ~delegate ~balance:credit
~script:({ code ; storage }, None (* TODO: initialize a big map from a map *))
~spendable ~delegatable
>>=? fun (ctxt, contract, origination) ->
>>=? fun (ctxt, contract) ->
Fees.origination_burn ctxt ~payer contract >>=? fun ctxt ->
logged_return descr ~origination (Item ((param_type, contract), rest), ctxt) in
let logged_return : ?origination:Contract.origination_nonce ->
logged_return descr (Item ((param_type, contract), rest), ctxt) in
let logged_return :
a stack * context ->
(a stack * context * Contract.origination_nonce) tzresult Lwt.t =
(a stack * context) tzresult Lwt.t =
logged_return descr in
match instr, stack with
(* stack ops *)
@ -202,10 +195,10 @@ let rec interp
logged_return (Item (None, rest), ctxt)
| If_none (bt, _), Item (None, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
step origination ctxt bt rest
step ctxt bt rest
| If_none (_, bf), Item (Some v, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
step origination ctxt bf (Item (v, rest))
step ctxt bf (Item (v, rest))
(* pairs *)
| Cons_pair, Item (a, Item (b, rest)) ->
Lwt.return (Gas.consume ctxt Interp_costs.pair) >>=? fun ctxt ->
@ -225,10 +218,10 @@ let rec interp
logged_return (Item (R v, rest), ctxt)
| If_left (bt, _), Item (L v, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
step origination ctxt bt (Item (v, rest))
step ctxt bt (Item (v, rest))
| If_left (_, bf), Item (R v, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
step origination ctxt bf (Item (v, rest))
step ctxt bf (Item (v, rest))
(* lists *)
| Cons_list, Item (hd, Item (tl, rest)) ->
Lwt.return (Gas.consume ctxt Interp_costs.cons) >>=? fun ctxt ->
@ -238,43 +231,43 @@ let rec interp
logged_return (Item ([], rest), ctxt)
| If_cons (_, bf), Item ([], rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
step origination ctxt bf rest
step ctxt bf rest
| If_cons (bt, _), Item (hd :: tl, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
step origination ctxt bt (Item (hd, Item (tl, rest)))
step ctxt bt (Item (hd, Item (tl, rest)))
| List_map, Item (lam, Item (l, rest)) ->
let rec loop rest ctxt origination l acc =
let rec loop rest ctxt l acc =
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
match l with
| [] -> return (List.rev acc, ctxt, origination)
| [] -> return (List.rev acc, ctxt)
| hd :: tl ->
interp ?log ctxt origination ~source ~payer ~self amount lam hd
>>=? fun (hd, ctxt, origination) ->
loop rest ctxt origination tl (hd :: acc)
in loop rest ctxt origination l [] >>=? fun (res, ctxt, origination) ->
logged_return ~origination (Item (res, rest), ctxt)
interp ?log ctxt ~source ~payer ~self amount lam hd
>>=? fun (hd, ctxt) ->
loop rest ctxt tl (hd :: acc)
in loop rest ctxt l [] >>=? fun (res, ctxt) ->
logged_return (Item (res, rest), ctxt)
| List_map_body body, Item (l, rest) ->
let rec loop rest ctxt origination l acc =
let rec loop rest ctxt l acc =
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
match l with
| [] -> return (Item (List.rev acc, rest), ctxt, origination)
| [] -> return (Item (List.rev acc, rest), ctxt)
| hd :: tl ->
step origination ctxt body (Item (hd, rest))
>>=? fun (Item (hd, rest), ctxt, origination) ->
loop rest ctxt origination tl (hd :: acc)
in loop rest ctxt origination l [] >>=? fun (res, ctxt, origination) ->
logged_return ~origination (res, ctxt)
step ctxt body (Item (hd, rest))
>>=? fun (Item (hd, rest), ctxt) ->
loop rest ctxt tl (hd :: acc)
in loop rest ctxt l [] >>=? fun (res, ctxt) ->
logged_return (res, ctxt)
| List_reduce, Item (lam, Item (l, Item (init, rest))) ->
let rec loop rest ctxt origination l acc =
let rec loop rest ctxt l acc =
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
match l with
| [] -> return (acc, ctxt, origination)
| [] -> return (acc, ctxt)
| hd :: tl ->
interp ?log ctxt origination ~source ~payer ~self amount lam (hd, acc)
>>=? fun (acc, ctxt, origination) ->
loop rest ctxt origination tl acc
in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) ->
logged_return ~origination (Item (res, rest), ctxt)
interp ?log ctxt ~source ~payer ~self amount lam (hd, acc)
>>=? fun (acc, ctxt) ->
loop rest ctxt tl acc
in loop rest ctxt l init >>=? fun (res, ctxt) ->
logged_return (Item (res, rest), ctxt)
| List_size, Item (list, rest) ->
Lwt.return
(List.fold_left
@ -285,16 +278,16 @@ let rec interp
(ok (0, ctxt)) list) >>=? fun (len, ctxt) ->
logged_return (Item (Script_int.(abs (of_int len)), rest), ctxt)
| List_iter body, Item (l, init) ->
let rec loop ctxt origination l stack =
let rec loop ctxt l stack =
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
match l with
| [] -> return (stack, ctxt, origination)
| [] -> return (stack, ctxt)
| hd :: tl ->
step origination ctxt body (Item (hd, stack))
>>=? fun (stack, ctxt, origination) ->
loop ctxt origination tl stack
in loop ctxt origination l init >>=? fun (res, ctxt, origination) ->
logged_return ~origination (res, ctxt)
step ctxt body (Item (hd, stack))
>>=? fun (stack, ctxt) ->
loop ctxt tl stack
in loop ctxt l init >>=? fun (res, ctxt) ->
logged_return (res, ctxt)
(* sets *)
| Empty_set t, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.empty_set) >>=? fun ctxt ->
@ -302,29 +295,29 @@ let rec interp
| Set_reduce, Item (lam, Item (set, Item (init, rest))) ->
Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set)) >>=? fun ctxt ->
let l = List.rev (set_fold (fun e acc -> e :: acc) set []) in
let rec loop rest ctxt origination l acc =
let rec loop rest ctxt l acc =
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
match l with
| [] -> return (acc, ctxt, origination)
| [] -> return (acc, ctxt)
| hd :: tl ->
interp ?log ctxt origination ~source ~payer ~self amount lam (hd, acc)
>>=? fun (acc, ctxt, origination) ->
loop rest ctxt origination tl acc
in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) ->
logged_return ~origination (Item (res, rest), ctxt)
interp ?log ctxt ~source ~payer ~self amount lam (hd, acc)
>>=? fun (acc, ctxt) ->
loop rest ctxt tl acc
in loop rest ctxt l init >>=? fun (res, ctxt) ->
logged_return (Item (res, rest), ctxt)
| Set_iter body, Item (set, init) ->
Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set)) >>=? fun ctxt ->
let l = List.rev (set_fold (fun e acc -> e :: acc) set []) in
let rec loop ctxt origination l stack =
let rec loop ctxt l stack =
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
match l with
| [] -> return (stack, ctxt, origination)
| [] -> return (stack, ctxt)
| hd :: tl ->
step origination ctxt body (Item (hd, stack))
>>=? fun (stack, ctxt, origination) ->
loop ctxt origination tl stack
in loop ctxt origination l init >>=? fun (res, ctxt, origination) ->
logged_return ~origination (res, ctxt)
step ctxt body (Item (hd, stack))
>>=? fun (stack, ctxt) ->
loop ctxt tl stack
in loop ctxt l init >>=? fun (res, ctxt) ->
logged_return (res, ctxt)
| Set_mem, Item (v, Item (set, rest)) ->
consume_gas_binop descr (set_mem, v, set) Interp_costs.set_mem rest ctxt
| Set_update, Item (v, Item (presence, Item (set, rest))) ->
@ -338,42 +331,42 @@ let rec interp
| Map_map, Item (lam, Item (map, rest)) ->
Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->
let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
let rec loop rest ctxt origination l acc =
let rec loop rest ctxt l acc =
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
match l with
| [] -> return (acc, ctxt, origination)
| [] -> return (acc, ctxt)
| (k, _) as hd :: tl ->
interp ?log ctxt origination ~source ~payer ~self amount lam hd
>>=? fun (hd, ctxt, origination) ->
loop rest ctxt origination tl (map_update k (Some hd) acc)
in loop rest ctxt origination l (empty_map (map_key_ty map)) >>=? fun (res, ctxt, origination) ->
logged_return ~origination (Item (res, rest), ctxt)
interp ?log ctxt ~source ~payer ~self amount lam hd
>>=? fun (hd, ctxt) ->
loop rest ctxt tl (map_update k (Some hd) acc)
in loop rest ctxt l (empty_map (map_key_ty map)) >>=? fun (res, ctxt) ->
logged_return (Item (res, rest), ctxt)
| Map_reduce, Item (lam, Item (map, Item (init, rest))) ->
Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->
let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
let rec loop rest ctxt origination l acc =
let rec loop rest ctxt l acc =
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
match l with
| [] -> return (acc, ctxt, origination)
| [] -> return (acc, ctxt)
| hd :: tl ->
interp ?log ctxt origination ~source ~payer ~self amount lam (hd, acc)
>>=? fun (acc, ctxt, origination) ->
loop rest ctxt origination tl acc
in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) ->
logged_return ~origination (Item (res, rest), ctxt)
interp ?log ctxt ~source ~payer ~self amount lam (hd, acc)
>>=? fun (acc, ctxt) ->
loop rest ctxt tl acc
in loop rest ctxt l init >>=? fun (res, ctxt) ->
logged_return (Item (res, rest), ctxt)
| Map_iter body, Item (map, init) ->
Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->
let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
let rec loop ctxt origination l stack =
let rec loop ctxt l stack =
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
match l with
| [] -> return (stack, ctxt, origination)
| [] -> return (stack, ctxt)
| hd :: tl ->
step origination ctxt body (Item (hd, stack))
>>=? fun (stack, ctxt, origination) ->
loop ctxt origination tl stack
in loop ctxt origination l init >>=? fun (res, ctxt, origination) ->
logged_return ~origination (res, ctxt)
step ctxt body (Item (hd, stack))
>>=? fun (stack, ctxt) ->
loop ctxt tl stack
in loop ctxt l init >>=? fun (res, ctxt) ->
logged_return (res, ctxt)
| Map_mem, Item (v, Item (map, rest)) ->
consume_gas_binop descr (map_mem, v, map) Interp_costs.map_mem rest ctxt
| Map_get, Item (v, Item (map, rest)) ->
@ -557,38 +550,38 @@ let rec interp
consume_gas_unop descr (Script_int.lognot, x) Interp_costs.lognot rest ctxt
(* control *)
| Seq (hd, tl), stack ->
step origination ctxt hd stack >>=? fun (trans, ctxt, origination) ->
step origination ctxt tl trans
step ctxt hd stack >>=? fun (trans, ctxt) ->
step ctxt tl trans
| If (bt, _), Item (true, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
step origination ctxt bt rest
step ctxt bt rest
| If (_, bf), Item (false, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
step origination ctxt bf rest
step ctxt bf rest
| Loop body, Item (true, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
step origination ctxt body rest >>=? fun (trans, ctxt, origination) ->
step origination ctxt descr trans
step ctxt body rest >>=? fun (trans, ctxt) ->
step ctxt descr trans
| Loop _, Item (false, rest) ->
logged_return (rest, ctxt)
| Loop_left body, Item (L v, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
step origination ctxt body (Item (v, rest)) >>=? fun (trans, ctxt, origination) ->
step origination ctxt descr trans
step ctxt body (Item (v, rest)) >>=? fun (trans, ctxt) ->
step ctxt descr trans
| Loop_left _, Item (R v, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
logged_return (Item (v, rest), ctxt)
| Dip b, Item (ign, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->
step origination ctxt b rest >>=? fun (res, ctxt, origination) ->
logged_return ~origination (Item (ign, res), ctxt)
step ctxt b rest >>=? fun (res, ctxt) ->
logged_return (Item (ign, res), ctxt)
| Exec, Item (arg, Item (lam, rest)) ->
Lwt.return (Gas.consume ctxt Interp_costs.exec) >>=? fun ctxt ->
interp ?log ctxt origination ~source ~payer ~self amount lam arg >>=? fun (res, ctxt, origination) ->
logged_return ~origination (Item (res, rest), ctxt)
interp ?log ctxt ~source ~payer ~self amount lam arg >>=? fun (res, ctxt) ->
logged_return (Item (res, rest), ctxt)
| Lambda lam, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
logged_return ~origination (Item (lam, rest), ctxt)
logged_return (Item (lam, rest), ctxt)
| Fail, _ ->
fail (Reject loc)
| Nop, stack ->
@ -681,11 +674,10 @@ let rec interp
Contract.spend_from_script ctxt self credit >>=? fun ctxt ->
Lwt.return Tez.(credit -? Constants.origination_burn ctxt) >>=? fun balance ->
Contract.originate ctxt
origination
~manager ~delegate ~balance
?script:None ~spendable:true ~delegatable >>=? fun (ctxt, contract, origination) ->
?script:None ~spendable:true ~delegatable >>=? fun (ctxt, contract) ->
Fees.origination_burn ctxt ~payer contract >>=? fun ctxt ->
logged_return ~origination (Item ((Unit_t, contract), rest), ctxt)
logged_return (Item ((Unit_t, contract), rest), ctxt)
| Implicit_account, Item (key, rest) ->
Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt ->
let contract = Contract.implicit_contract key in
@ -750,36 +742,35 @@ let rec interp
| Some log ->
log := (code.loc, Gas.level ctxt, unparse_stack ctxt (stack, code.bef)) :: !log
end ;
step origination ctxt code stack >>=? fun (Item (ret, Empty), ctxt, origination) ->
return (ret, ctxt, origination)
step ctxt code stack >>=? fun (Item (ret, Empty), ctxt) ->
return (ret, ctxt)
(* ---- contract handling ---------------------------------------------------*)
and execute ?log ctxt ~check_operations origination_nonce ~source ~payer ~self script amount arg :
(Script.expr * internal_operation list * context * Contract.origination_nonce *
and execute ?log ctxt ~check_operations ~source ~payer ~self script amount arg :
(Script.expr * internal_operation list * context *
Script_typed_ir.ex_big_map option) tzresult Lwt.t =
parse_script ctxt ~check_operations script
>>=? fun ((Ex_script { code ; arg_type ; storage ; storage_type }), ctxt) ->
parse_data ctxt ~check_operations arg_type arg >>=? fun (arg, ctxt) ->
trace
(Runtime_contract_error (self, script.code))
(interp ?log ctxt origination_nonce ~source ~payer ~self amount code (arg, storage))
>>=? fun ((ops, sto), ctxt, origination) ->
(interp ?log ctxt ~source ~payer ~self amount code (arg, storage))
>>=? fun ((ops, sto), ctxt) ->
Lwt.return @@ unparse_data ctxt storage_type sto >>=? fun (storage, ctxt) ->
return (Micheline.strip_locations storage, ops, ctxt, origination,
return (Micheline.strip_locations storage, ops, ctxt,
Script_ir_translator.extract_big_map storage_type sto)
type execution_result =
{ ctxt : context ;
origination_nonce : Contract.origination_nonce ;
storage : Script.expr ;
big_map_diff : Contract.big_map_diff option ;
operations : internal_operation list }
let trace ctxt origination_nonce ~check_operations ~source ~payer ~self:(self, script) ~parameter ~amount =
let trace ctxt ~check_operations ~source ~payer ~self:(self, script) ~parameter ~amount =
let log = ref [] in
execute ~log ctxt ~check_operations origination_nonce ~source ~payer ~self script amount (Micheline.root parameter)
>>=? fun (storage, operations, ctxt, origination_nonce, big_map_diff) ->
execute ~log ctxt ~check_operations ~source ~payer ~self script amount (Micheline.root parameter)
>>=? fun (storage, operations, ctxt, big_map_diff) ->
begin match big_map_diff with
| None -> return (None, ctxt)
| Some big_map_diff ->
@ -787,15 +778,15 @@ let trace ctxt origination_nonce ~check_operations ~source ~payer ~self:(self, s
return (Some big_map_diff, ctxt)
end >>=? fun (big_map_diff, ctxt) ->
let trace = List.rev !log in
return ({ ctxt ; origination_nonce ; storage ; big_map_diff ; operations }, trace)
return ({ ctxt ; storage ; big_map_diff ; operations }, trace)
let execute ctxt origination_nonce ~check_operations ~source ~payer ~self:(self, script) ~parameter ~amount =
execute ctxt origination_nonce ~check_operations ~source ~payer ~self script amount (Micheline.root parameter)
>>=? fun (storage, operations, ctxt, origination_nonce, big_map_diff) ->
let execute ctxt ~check_operations ~source ~payer ~self:(self, script) ~parameter ~amount =
execute ctxt ~check_operations ~source ~payer ~self script amount (Micheline.root parameter)
>>=? fun (storage, operations, ctxt, big_map_diff) ->
begin match big_map_diff with
| None -> return (None, ctxt)
| Some big_map_diff ->
Script_ir_translator.to_serializable_big_map ctxt big_map_diff >>=? fun (big_map_diff, ctxt) ->
return (Some big_map_diff, ctxt)
end >>=? fun (big_map_diff, ctxt) ->
return { ctxt ; origination_nonce ; storage ; big_map_diff ; operations }
return { ctxt ; storage ; big_map_diff ; operations }

5
src/proto_alpha/lib_protocol/src/script_interpreter.mli
View File

@ -15,13 +15,12 @@ type error += Runtime_contract_error : Contract.t * Script.expr -> error
type execution_result =
{ ctxt : context ;
origination_nonce : Contract.origination_nonce ;
storage : Script.expr ;
big_map_diff : Contract.big_map_diff option ;
operations : internal_operation list }
val execute:
Alpha_context.t -> Contract.origination_nonce ->
Alpha_context.t ->
check_operations: bool ->
source: Contract.t ->
payer: Contract.t ->
@ -34,7 +33,7 @@ type execution_trace =
(Script.location * Gas.t * Script.expr list) list
val trace:
Alpha_context.t -> Contract.origination_nonce ->
Alpha_context.t ->
check_operations: bool ->
source: Contract.t ->
payer: Contract.t ->

3
src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml
View File

@ -20,8 +20,7 @@ let operation
pred_block_hash
0
hash
operation >>=? fun { ctxt = tc ; origination_nonce ; ignored_error } ->
let contracts = Proto_alpha.Alpha_context.Contract.originated_contracts origination_nonce in
operation >>=? fun { ctxt = tc ; contracts ; ignored_error } ->
return ((contracts, ignored_error), tc)

4
src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml
View File

@ -28,11 +28,11 @@ let execute_code_pred
let apply_op = Helpers_operation.apply_of_proto
(Some op) op_header dummy_protop in
let hash = Operation.hash apply_op in
let dummy_nonce = Contract.initial_origination_nonce hash in
let amount = Tez.zero in
Lwt.return (Proto_alpha.Alpha_context.Gas.set_limit tc gas) >>=? fun tc ->
let tc = Contract.init_origination_nonce tc hash in
Script_interpreter.execute
tc dummy_nonce
tc
~check_operations: true
~source: op.contract
~payer: op.contract

3
src/proto_alpha/lib_protocol/test/test_activation.ml
View File

@ -61,8 +61,7 @@ let test_simple_activation () =
Proto_alpha.Apply.apply_anonymous_operation
starting_block.tezos_context
None
starting_block.hash
activation_operation >>=? fun (ctxt, _) ->
activation_operation >>=? fun ctxt ->
let contract = Contract.implicit_contract pkh in

7
src/proto_alpha/lib_protocol/test/test_michelson.ml
View File

@ -48,12 +48,11 @@ let parse_execute sb ?tc code_str param_str storage_str =
let param = parse_param param_str in
let script = parse_script code_str storage_str in
Script.execute_code_pred ?tc sb script param
>>=?? fun (dst, { ctxt = tc ; operations = ops ;
origination_nonce = nonce ; big_map_diff = bgm }) ->
>>=?? fun (dst, { ctxt = tc ; operations = ops ; big_map_diff = bgm }) ->
let payer =
(List.hd Account.bootstrap_accounts).contract in
Proto_alpha.Apply.apply_internal_manager_operations tc ~payer nonce ops >>=?? fun (tc, nonce, err, _, ops) ->
let contracts = Contract.originated_contracts nonce in
Proto_alpha.Apply.apply_internal_manager_operations tc ~payer ops >>=?? fun (tc, err, _, ops) ->
Contract.originated_from_current_nonce tc >>=?? fun contracts ->
match err with
| None ->
let tc = Proto_alpha.Alpha_context.Gas.set_unlimited tc in