Alpha: thread origination_nonce in the context
This commit is contained in:
parent
f05b02f74f
commit
18c77318fb
@ -76,6 +76,8 @@ end
|
|||||||
module Contract = struct
|
module Contract = struct
|
||||||
include Contract_repr
|
include Contract_repr
|
||||||
include Contract_storage
|
include Contract_storage
|
||||||
|
let init_origination_nonce = Raw_context.init_origination_nonce
|
||||||
|
let unset_origination_nonce = Raw_context.unset_origination_nonce
|
||||||
end
|
end
|
||||||
module Delegate = Delegate_storage
|
module Delegate = Delegate_storage
|
||||||
module Roll = struct
|
module Roll = struct
|
||||||
|
@ -485,14 +485,6 @@ module Contract : sig
|
|||||||
|
|
||||||
val list: context -> contract list Lwt.t
|
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:
|
val get_manager:
|
||||||
context -> contract -> public_key_hash tzresult Lwt.t
|
context -> contract -> public_key_hash tzresult Lwt.t
|
||||||
|
|
||||||
@ -517,17 +509,20 @@ module Contract : sig
|
|||||||
val get_balance:
|
val get_balance:
|
||||||
context -> contract -> Tez.t tzresult Lwt.t
|
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
|
type big_map_diff = (string * Script.expr option) list
|
||||||
|
|
||||||
val originate:
|
val originate:
|
||||||
context ->
|
context ->
|
||||||
origination_nonce ->
|
|
||||||
balance: Tez.t ->
|
balance: Tez.t ->
|
||||||
manager: public_key_hash ->
|
manager: public_key_hash ->
|
||||||
?script: (Script.t * big_map_diff option) ->
|
?script: (Script.t * big_map_diff option) ->
|
||||||
delegate: public_key_hash option ->
|
delegate: public_key_hash option ->
|
||||||
spendable: bool ->
|
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
|
type error += Balance_too_low of contract * Tez.t * Tez.t
|
||||||
|
|
||||||
|
@ -369,8 +369,8 @@ let apply_amendment_operation_content ctxt delegate = function
|
|||||||
Amendment.record_ballot ctxt delegate proposal ballot
|
Amendment.record_ballot ctxt delegate proposal ballot
|
||||||
|
|
||||||
let apply_manager_operation_content
|
let apply_manager_operation_content
|
||||||
ctxt origination_nonce ~payer ~source ~internal = function
|
ctxt ~payer ~source ~internal = function
|
||||||
| Reveal _ -> return (ctxt, origination_nonce, None, Tez.zero, [])
|
| Reveal _ -> return (ctxt, None, Tez.zero, [])
|
||||||
| Transaction { amount ; parameters ; destination } ->
|
| Transaction { amount ; parameters ; destination } ->
|
||||||
begin
|
begin
|
||||||
begin
|
begin
|
||||||
@ -384,28 +384,28 @@ let apply_manager_operation_content
|
|||||||
| None -> begin
|
| None -> begin
|
||||||
match parameters with
|
match parameters with
|
||||||
| None ->
|
| None ->
|
||||||
return (ctxt, origination_nonce, None, Tez.zero, [])
|
return (ctxt, None, Tez.zero, [])
|
||||||
| Some arg ->
|
| Some arg ->
|
||||||
match Micheline.root arg with
|
match Micheline.root arg with
|
||||||
| Prim (_, D_Unit, [], _) ->
|
| Prim (_, D_Unit, [], _) ->
|
||||||
return (ctxt, origination_nonce, None, Tez.zero, [])
|
return (ctxt, None, Tez.zero, [])
|
||||||
| _ -> fail (Bad_contract_parameter (destination, None, parameters))
|
| _ -> fail (Bad_contract_parameter (destination, None, parameters))
|
||||||
end
|
end
|
||||||
| Some script ->
|
| Some script ->
|
||||||
let call_contract ctxt parameter =
|
let call_contract ctxt parameter =
|
||||||
Script_interpreter.execute
|
Script_interpreter.execute
|
||||||
ctxt origination_nonce
|
ctxt
|
||||||
~check_operations:(not internal)
|
~check_operations:(not internal)
|
||||||
~source ~payer ~self:(destination, script) ~amount ~parameter
|
~source ~payer ~self:(destination, script) ~amount ~parameter
|
||||||
>>= function
|
>>= function
|
||||||
| Ok { ctxt ; origination_nonce ; storage ; big_map_diff ; operations } ->
|
| Ok { ctxt ; storage ; big_map_diff ; operations } ->
|
||||||
Contract.update_script_storage
|
Contract.update_script_storage
|
||||||
ctxt destination storage big_map_diff >>=? fun ctxt ->
|
ctxt destination storage big_map_diff >>=? fun ctxt ->
|
||||||
Fees.update_script_storage
|
Fees.update_script_storage
|
||||||
ctxt ~payer destination >>=? fun (ctxt, fees) ->
|
ctxt ~payer destination >>=? fun (ctxt, fees) ->
|
||||||
return (ctxt, origination_nonce, None, fees, operations)
|
return (ctxt, None, fees, operations)
|
||||||
| Error err ->
|
| 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, _, _) ->
|
Lwt.return @@ Script_ir_translator.parse_toplevel script.code >>=? fun (arg_type, _, _) ->
|
||||||
let arg_type = Micheline.strip_locations arg_type in
|
let arg_type = Micheline.strip_locations arg_type in
|
||||||
match parameters, Micheline.root arg_type with
|
match parameters, Micheline.root arg_type with
|
||||||
@ -416,7 +416,7 @@ let apply_manager_operation_content
|
|||||||
| Ok ctxt -> call_contract ctxt parameters
|
| Ok ctxt -> call_contract ctxt parameters
|
||||||
| Error errs ->
|
| Error errs ->
|
||||||
let err = Bad_contract_parameter (destination, Some arg_type, Some parameters) in
|
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
|
end
|
||||||
| None, _ -> fail (Bad_contract_parameter (destination, Some arg_type, None))
|
| None, _ -> fail (Bad_contract_parameter (destination, Some arg_type, None))
|
||||||
end
|
end
|
||||||
@ -431,59 +431,58 @@ let apply_manager_operation_content
|
|||||||
end >>=? fun (script, ctxt) ->
|
end >>=? fun (script, ctxt) ->
|
||||||
Contract.spend ctxt source credit >>=? fun ctxt ->
|
Contract.spend ctxt source credit >>=? fun ctxt ->
|
||||||
Contract.originate ctxt
|
Contract.originate ctxt
|
||||||
origination_nonce
|
|
||||||
~manager ~delegate ~balance:credit
|
~manager ~delegate ~balance:credit
|
||||||
?script
|
?script
|
||||||
~spendable ~delegatable >>=? fun (ctxt, contract, origination_nonce) ->
|
~spendable ~delegatable >>=? fun (ctxt, contract) ->
|
||||||
Fees.origination_burn ctxt ~payer contract >>=? fun ctxt ->
|
Fees.origination_burn ctxt ~payer contract >>=? fun ctxt ->
|
||||||
return (ctxt, origination_nonce, None, Tez.zero, [])
|
return (ctxt, None, Tez.zero, [])
|
||||||
| Delegation delegate ->
|
| Delegation delegate ->
|
||||||
Delegate.set ctxt source delegate >>=? fun ctxt ->
|
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 apply_internal_manager_operations ctxt ~payer ops =
|
||||||
let rec apply ctxt origination_nonce storage_fees applied worklist =
|
let rec apply ctxt storage_fees applied worklist =
|
||||||
match worklist with
|
match worklist with
|
||||||
| [] -> return (ctxt, origination_nonce, None, storage_fees, List.rev applied)
|
| [] -> return (ctxt, None, storage_fees, List.rev applied)
|
||||||
| { source ; operation ;
|
| { source ; operation ;
|
||||||
signature = _ (* at this point the signature must have been
|
signature = _ (* at this point the signature must have been
|
||||||
checked if the operation has been
|
checked if the operation has been
|
||||||
deserialized from the outside world *) } as op :: rest ->
|
deserialized from the outside world *) } as op :: rest ->
|
||||||
apply_manager_operation_content ctxt origination_nonce ~source ~payer ~internal:true operation
|
apply_manager_operation_content ctxt ~source ~payer ~internal:true operation
|
||||||
>>=? fun (ctxt, origination_nonce, ignored_error, operation_storage_fees, emitted) ->
|
>>=? fun (ctxt, ignored_error, operation_storage_fees, emitted) ->
|
||||||
Lwt.return Tez.(storage_fees +? operation_storage_fees) >>=? fun storage_fees ->
|
Lwt.return Tez.(storage_fees +? operation_storage_fees) >>=? fun storage_fees ->
|
||||||
match ignored_error with
|
match ignored_error with
|
||||||
| Some err ->
|
| 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 ->
|
| None ->
|
||||||
apply ctxt origination_nonce storage_fees (op :: applied) (rest @ emitted) in
|
apply ctxt storage_fees (op :: applied) (rest @ emitted) in
|
||||||
apply ctxt origination_nonce Tez.zero [] ops
|
apply ctxt Tez.zero [] ops
|
||||||
|
|
||||||
let apply_manager_operations ctxt origination_nonce source ops =
|
let apply_manager_operations ctxt source ops =
|
||||||
let rec apply ctxt origination_nonce storage_fees applied ops =
|
let rec apply ctxt storage_fees applied ops =
|
||||||
match ops with
|
match ops with
|
||||||
| [] -> return (ctxt, origination_nonce, None, storage_fees, List.rev applied)
|
| [] -> return (ctxt, None, storage_fees, List.rev applied)
|
||||||
| operation :: rest ->
|
| operation :: rest ->
|
||||||
Contract.must_exist ctxt source >>=? fun () ->
|
Contract.must_exist ctxt source >>=? fun () ->
|
||||||
apply_manager_operation_content ctxt origination_nonce ~source ~payer:source ~internal:false operation
|
apply_manager_operation_content ctxt ~source ~payer:source ~internal:false operation
|
||||||
>>=? fun (ctxt, origination_nonce, ignored_error, operation_storage_fees, emitted) ->
|
>>=? fun (ctxt, ignored_error, operation_storage_fees, emitted) ->
|
||||||
Lwt.return Tez.(storage_fees +? operation_storage_fees) >>=? fun storage_fees ->
|
Lwt.return Tez.(storage_fees +? operation_storage_fees) >>=? fun storage_fees ->
|
||||||
let op = { source ; operation ; signature = None } in
|
let op = { source ; operation ; signature = None } in
|
||||||
match ignored_error with
|
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 ->
|
| None ->
|
||||||
apply_internal_manager_operations ctxt origination_nonce ~payer:source emitted
|
apply_internal_manager_operations ctxt ~payer:source emitted
|
||||||
>>=? fun (ctxt, origination_nonce, ignored_error, internal_storage_fees, internal_applied) ->
|
>>=? fun (ctxt, ignored_error, internal_storage_fees, internal_applied) ->
|
||||||
let applied = List.rev internal_applied @ (op :: applied) in
|
let applied = List.rev internal_applied @ (op :: applied) in
|
||||||
Lwt.return Tez.(storage_fees +? internal_storage_fees) >>=? fun storage_fees ->
|
Lwt.return Tez.(storage_fees +? internal_storage_fees) >>=? fun storage_fees ->
|
||||||
match ignored_error with
|
match ignored_error with
|
||||||
| Some _ -> return (ctxt, origination_nonce, ignored_error, storage_fees, List.rev applied)
|
| Some _ -> return (ctxt, ignored_error, storage_fees, List.rev applied)
|
||||||
| None -> apply ctxt origination_nonce storage_fees applied rest in
|
| None -> apply ctxt storage_fees applied rest in
|
||||||
apply ctxt origination_nonce Tez.zero [] ops
|
apply ctxt Tez.zero [] ops
|
||||||
|
|
||||||
let apply_sourced_operation
|
let apply_sourced_operation
|
||||||
ctxt pred_block block_prio
|
ctxt pred_block block_prio
|
||||||
operation origination_nonce ops =
|
operation ops =
|
||||||
match ops with
|
match ops with
|
||||||
| Manager_operations { source ; fee ; counter ; operations ; gas_limit } ->
|
| Manager_operations { source ; fee ; counter ; operations ; gas_limit } ->
|
||||||
let revealed_public_keys =
|
let revealed_public_keys =
|
||||||
@ -507,34 +506,34 @@ let apply_sourced_operation
|
|||||||
Contract.spend ctxt source fee >>=? fun ctxt ->
|
Contract.spend ctxt source fee >>=? fun ctxt ->
|
||||||
add_fees ctxt fee >>=? fun ctxt ->
|
add_fees ctxt fee >>=? fun ctxt ->
|
||||||
Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
|
Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
|
||||||
apply_manager_operations ctxt origination_nonce source operations
|
apply_manager_operations ctxt source operations
|
||||||
>>=? fun (ctxt, origination_nonce, ignored_error, storage_fees, applied) ->
|
>>=? fun (ctxt, ignored_error, storage_fees, applied) ->
|
||||||
return (ctxt, origination_nonce, ignored_error, storage_fees, applied)
|
return (ctxt, ignored_error, storage_fees, applied)
|
||||||
| Consensus_operation content ->
|
| Consensus_operation content ->
|
||||||
apply_consensus_operation_content ctxt
|
apply_consensus_operation_content ctxt
|
||||||
pred_block block_prio operation content >>=? fun 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 } ->
|
| Amendment_operation { source ; operation = content } ->
|
||||||
Roll.delegate_pubkey ctxt source >>=? fun delegate ->
|
Roll.delegate_pubkey ctxt source >>=? fun delegate ->
|
||||||
Operation.check_signature delegate operation >>=? fun () ->
|
Operation.check_signature delegate operation >>=? fun () ->
|
||||||
(* TODO, see how to extract the public key hash after this operation to
|
(* TODO, see how to extract the public key hash after this operation to
|
||||||
pass it to apply_delegate_operation_content *)
|
pass it to apply_delegate_operation_content *)
|
||||||
apply_amendment_operation_content ctxt source content >>=? fun ctxt ->
|
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) ->
|
| Dictator_operation (Activate hash) ->
|
||||||
let dictator_pubkey = Constants.dictator_pubkey ctxt in
|
let dictator_pubkey = Constants.dictator_pubkey ctxt in
|
||||||
Operation.check_signature dictator_pubkey operation >>=? fun () ->
|
Operation.check_signature dictator_pubkey operation >>=? fun () ->
|
||||||
activate ctxt hash >>= fun ctxt ->
|
activate ctxt hash >>= fun ctxt ->
|
||||||
return (ctxt, origination_nonce, None, Tez.zero, [])
|
return (ctxt, None, Tez.zero, [])
|
||||||
| Dictator_operation (Activate_testchain hash) ->
|
| Dictator_operation (Activate_testchain hash) ->
|
||||||
let dictator_pubkey = Constants.dictator_pubkey ctxt in
|
let dictator_pubkey = Constants.dictator_pubkey ctxt in
|
||||||
Operation.check_signature dictator_pubkey operation >>=? fun () ->
|
Operation.check_signature dictator_pubkey operation >>=? fun () ->
|
||||||
let expiration = (* in two days maximum... *)
|
let expiration = (* in two days maximum... *)
|
||||||
Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in
|
Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in
|
||||||
fork_test_chain ctxt hash expiration >>= fun ctxt ->
|
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
|
match kind with
|
||||||
| Seed_nonce_revelation { level ; nonce } ->
|
| Seed_nonce_revelation { level ; nonce } ->
|
||||||
let level = Level.from_raw ctxt level in
|
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 =
|
let seed_nonce_revelation_tip =
|
||||||
Constants.seed_nonce_revelation_tip ctxt in
|
Constants.seed_nonce_revelation_tip ctxt in
|
||||||
add_rewards ctxt seed_nonce_revelation_tip >>=? fun ctxt ->
|
add_rewards ctxt seed_nonce_revelation_tip >>=? fun ctxt ->
|
||||||
return (ctxt, origination_nonce)
|
return ctxt
|
||||||
| Double_endorsement_evidence { op1 ; op2 } -> begin
|
| Double_endorsement_evidence { op1 ; op2 } -> begin
|
||||||
match op1.contents, op2.contents with
|
match op1.contents, op2.contents with
|
||||||
| Sourced_operations (Consensus_operation (Endorsements e1)),
|
| Sourced_operations (Consensus_operation (Endorsements e1)),
|
||||||
@ -581,7 +580,7 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
|
|||||||
| Ok v -> v
|
| Ok v -> v
|
||||||
| Error _ -> Tez.zero in
|
| Error _ -> Tez.zero in
|
||||||
add_rewards ctxt reward >>=? fun ctxt ->
|
add_rewards ctxt reward >>=? fun ctxt ->
|
||||||
return (ctxt, origination_nonce)
|
return ctxt
|
||||||
| _, _ -> fail Invalid_double_endorsement_evidence
|
| _, _ -> fail Invalid_double_endorsement_evidence
|
||||||
end
|
end
|
||||||
| Double_baking_evidence { bh1 ; bh2 } ->
|
| Double_baking_evidence { bh1 ; bh2 } ->
|
||||||
@ -620,7 +619,7 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
|
|||||||
| Ok v -> v
|
| Ok v -> v
|
||||||
| Error _ -> Tez.zero in
|
| Error _ -> Tez.zero in
|
||||||
add_rewards ctxt reward >>=? fun ctxt ->
|
add_rewards ctxt reward >>=? fun ctxt ->
|
||||||
return (ctxt, origination_nonce)
|
return ctxt
|
||||||
| Activation { id = pkh ; secret } ->
|
| Activation { id = pkh ; secret } ->
|
||||||
let h_pkh = Unclaimed_public_key_hash.of_ed25519_pkh pkh in
|
let h_pkh = Unclaimed_public_key_hash.of_ed25519_pkh pkh in
|
||||||
Commitment.get_opt ctxt h_pkh >>=? function
|
Commitment.get_opt ctxt h_pkh >>=? function
|
||||||
@ -632,12 +631,12 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
|
|||||||
Wrong_activation_secret >>=? fun () ->
|
Wrong_activation_secret >>=? fun () ->
|
||||||
Commitment.delete ctxt h_pkh >>=? fun ctxt ->
|
Commitment.delete ctxt h_pkh >>=? fun ctxt ->
|
||||||
Contract.(credit ctxt (implicit_contract (Signature.Ed25519 pkh)) amount) >>=? fun ctxt ->
|
Contract.(credit ctxt (implicit_contract (Signature.Ed25519 pkh)) amount) >>=? fun ctxt ->
|
||||||
return (ctxt, origination_nonce)
|
return ctxt
|
||||||
|
|
||||||
type operation_result =
|
type operation_result =
|
||||||
{ ctxt : context ;
|
{ ctxt : context ;
|
||||||
gas : Gas.t ;
|
gas : Gas.t ;
|
||||||
origination_nonce : Contract.origination_nonce ;
|
contracts : Contract.t list ;
|
||||||
ignored_error : error list option ;
|
ignored_error : error list option ;
|
||||||
internal_operations : internal_operation list ;
|
internal_operations : internal_operation list ;
|
||||||
fees : Tez.t ;
|
fees : Tez.t ;
|
||||||
@ -646,25 +645,26 @@ type operation_result =
|
|||||||
|
|
||||||
let apply_operation
|
let apply_operation
|
||||||
ctxt delegate pred_block block_prio hash operation =
|
ctxt delegate pred_block block_prio hash operation =
|
||||||
|
let ctxt = Contract.init_origination_nonce ctxt hash in
|
||||||
begin match operation.contents with
|
begin match operation.contents with
|
||||||
| Anonymous_operations ops ->
|
| Anonymous_operations ops ->
|
||||||
let origination_nonce = Contract.initial_origination_nonce hash in
|
|
||||||
fold_left_s
|
fold_left_s
|
||||||
(fun (ctxt, origination_nonce) op ->
|
(fun ctxt op ->
|
||||||
apply_anonymous_operation ctxt delegate origination_nonce op)
|
apply_anonymous_operation ctxt delegate op)
|
||||||
(ctxt, origination_nonce) ops
|
ctxt ops
|
||||||
>>=? fun (ctxt, origination_nonce) ->
|
>>=? fun ctxt ->
|
||||||
return (ctxt, origination_nonce, None, Tez.zero, [])
|
return (ctxt, None, Tez.zero, [])
|
||||||
| Sourced_operations op ->
|
| Sourced_operations op ->
|
||||||
let origination_nonce = Contract.initial_origination_nonce hash in
|
|
||||||
apply_sourced_operation
|
apply_sourced_operation
|
||||||
ctxt pred_block block_prio
|
ctxt pred_block block_prio
|
||||||
operation origination_nonce op
|
operation op
|
||||||
end >>=? fun (ctxt, origination_nonce, ignored_error, storage_fees, internal_operations) ->
|
end >>=? fun (ctxt, ignored_error, storage_fees, internal_operations) ->
|
||||||
let gas = Gas.level ctxt in
|
let gas = Gas.level ctxt in
|
||||||
let ctxt = Gas.set_unlimited ctxt in
|
let ctxt = Gas.set_unlimited ctxt in
|
||||||
return { ctxt ; gas ; origination_nonce ; ignored_error ; storage_fees ;
|
Contract.originated_from_current_nonce ctxt >>=? fun contracts ->
|
||||||
internal_operations ;
|
let ctxt = Contract.unset_origination_nonce ctxt in
|
||||||
|
return { ctxt ; gas ; ignored_error ; storage_fees ;
|
||||||
|
internal_operations ; contracts ;
|
||||||
fees = Alpha_context.get_fees ctxt ;
|
fees = Alpha_context.get_fees ctxt ;
|
||||||
rewards = Alpha_context.get_rewards ctxt }
|
rewards = Alpha_context.get_rewards ctxt }
|
||||||
|
|
||||||
|
@ -243,10 +243,11 @@ let create_base c contract
|
|||||||
return c) >>=? fun c ->
|
return c) >>=? fun c ->
|
||||||
return (c, contract)
|
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
|
let contract = Contract_repr.originated_contract nonce in
|
||||||
create_base c contract ~balance ~manager ~delegate ?script ~spendable ~delegatable >>=? fun (ctxt, contract) ->
|
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 =
|
let create_implicit c manager ~balance =
|
||||||
create_base c (Contract_repr.implicit_contract manager)
|
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 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 =
|
let check_counter_increment c contract counter =
|
||||||
Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
|
Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
|
||||||
let expected = Int32.succ contract_counter in
|
let expected = Int32.succ contract_counter in
|
||||||
|
@ -83,14 +83,17 @@ val spend_from_script:
|
|||||||
|
|
||||||
val originate:
|
val originate:
|
||||||
Raw_context.t ->
|
Raw_context.t ->
|
||||||
Contract_repr.origination_nonce ->
|
|
||||||
balance:Tez_repr.t ->
|
balance:Tez_repr.t ->
|
||||||
manager:Signature.Public_key_hash.t ->
|
manager:Signature.Public_key_hash.t ->
|
||||||
?script:(Script_repr.t * big_map_diff option) ->
|
?script:(Script_repr.t * big_map_diff option) ->
|
||||||
delegate:Signature.Public_key_hash.t option ->
|
delegate:Signature.Public_key_hash.t option ->
|
||||||
spendable:bool ->
|
spendable:bool ->
|
||||||
delegatable: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:
|
val init:
|
||||||
Raw_context.t -> Raw_context.t tzresult Lwt.t
|
Raw_context.t -> Raw_context.t tzresult Lwt.t
|
||||||
|
@ -24,13 +24,12 @@ module S = struct
|
|||||||
RPC_path.(custom_root / "minimal_timestamp")
|
RPC_path.(custom_root / "minimal_timestamp")
|
||||||
|
|
||||||
let run_code_input_encoding =
|
let run_code_input_encoding =
|
||||||
(obj6
|
(obj5
|
||||||
(req "script" Script.expr_encoding)
|
(req "script" Script.expr_encoding)
|
||||||
(req "storage" Script.expr_encoding)
|
(req "storage" Script.expr_encoding)
|
||||||
(req "input" Script.expr_encoding)
|
(req "input" Script.expr_encoding)
|
||||||
(req "amount" Tez.encoding)
|
(req "amount" Tez.encoding)
|
||||||
(req "contract" Contract.encoding)
|
(req "contract" Contract.encoding))
|
||||||
(opt "origination_nonce" Contract.origination_nonce_encoding))
|
|
||||||
|
|
||||||
let run_code =
|
let run_code =
|
||||||
RPC_service.post_service
|
RPC_service.post_service
|
||||||
@ -153,22 +152,9 @@ module I = struct
|
|||||||
ctxt (Some baker_pkh) pred_block block_prio hash operation
|
ctxt (Some baker_pkh) pred_block block_prio hash operation
|
||||||
>>=? function
|
>>=? function
|
||||||
| { ignored_error = Some script_err ; _ } -> Lwt.return (Error script_err)
|
| { ignored_error = Some script_err ; _ } -> Lwt.return (Error script_err)
|
||||||
| { gas ; origination_nonce ; internal_operations ; _ } ->
|
| { gas ; contracts ; internal_operations ; _ } ->
|
||||||
let contracts = Contract.originated_contracts origination_nonce in
|
|
||||||
Lwt.return (Ok (contracts, internal_operations, gas))
|
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
|
end
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
@ -179,15 +165,12 @@ let () =
|
|||||||
Baking.minimal_time ctxt slot timestamp
|
Baking.minimal_time ctxt slot timestamp
|
||||||
end ;
|
end ;
|
||||||
register0 S.apply_operation I.apply_operation ;
|
register0 S.apply_operation I.apply_operation ;
|
||||||
register0 S.run_code begin fun ctxt () parameters ->
|
register0 S.run_code begin fun ctxt ()
|
||||||
let (code, storage, parameter, amount, contract, gas, origination_nonce) =
|
(code, storage, parameter, amount, contract) ->
|
||||||
I.run_parameters ctxt parameters in
|
Lwt.return (Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt)) >>=? fun ctxt ->
|
||||||
begin if Compare.Z.(gas > Z.zero) then
|
let ctxt = Contract.init_origination_nonce ctxt Operation_hash.zero in
|
||||||
Lwt.return (Gas.set_limit ctxt gas)
|
|
||||||
else
|
|
||||||
return (Gas.set_unlimited ctxt) end >>=? fun ctxt ->
|
|
||||||
Script_interpreter.execute
|
Script_interpreter.execute
|
||||||
ctxt origination_nonce
|
ctxt
|
||||||
~check_operations:true
|
~check_operations:true
|
||||||
~source:contract (* transaction initiator *)
|
~source:contract (* transaction initiator *)
|
||||||
~payer:contract (* storage fees payer *)
|
~payer:contract (* storage fees payer *)
|
||||||
@ -196,15 +179,12 @@ let () =
|
|||||||
>>=? fun { Script_interpreter.storage ; operations ; big_map_diff ; _ } ->
|
>>=? fun { Script_interpreter.storage ; operations ; big_map_diff ; _ } ->
|
||||||
return (storage, operations, big_map_diff)
|
return (storage, operations, big_map_diff)
|
||||||
end ;
|
end ;
|
||||||
register0 S.trace_code begin fun ctxt () parameters ->
|
register0 S.trace_code begin fun ctxt ()
|
||||||
let (code, storage, parameter, amount, contract, gas, origination_nonce) =
|
(code, storage, parameter, amount, contract) ->
|
||||||
I.run_parameters ctxt parameters in
|
Lwt.return (Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt)) >>=? fun ctxt ->
|
||||||
begin if Compare.Z.(gas > Z.zero) then
|
let ctxt = Contract.init_origination_nonce ctxt Operation_hash.zero in
|
||||||
Lwt.return (Gas.set_limit ctxt gas)
|
|
||||||
else
|
|
||||||
return (Gas.set_unlimited ctxt) end >>=? fun ctxt ->
|
|
||||||
Script_interpreter.trace
|
Script_interpreter.trace
|
||||||
ctxt origination_nonce
|
ctxt
|
||||||
~check_operations:true
|
~check_operations:true
|
||||||
~source:contract (* transaction initiator *)
|
~source:contract (* transaction initiator *)
|
||||||
~payer:contract (* storage fees payer *)
|
~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) =
|
let run_code ctxt block code (storage, input, amount, contract) =
|
||||||
RPC_context.make_call0 S.run_code ctxt
|
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 =
|
let apply_operation ctxt block pred_block hash forged_operation signature =
|
||||||
RPC_context.make_call0 S.apply_operation ctxt
|
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) =
|
let trace_code ctxt block code (storage, input, amount, contract) =
|
||||||
RPC_context.make_call0 S.trace_code ctxt
|
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 =
|
let typecheck_code ctxt block =
|
||||||
RPC_context.make_call0 S.typecheck_code ctxt block ()
|
RPC_context.make_call0 S.typecheck_code ctxt block ()
|
||||||
|
@ -21,6 +21,7 @@ type t = {
|
|||||||
rewards: Tez_repr.t ;
|
rewards: Tez_repr.t ;
|
||||||
block_gas: Z.t ;
|
block_gas: Z.t ;
|
||||||
operation_gas: Gas_repr.t ;
|
operation_gas: Gas_repr.t ;
|
||||||
|
origination_nonce: Contract_repr.origination_nonce option ;
|
||||||
}
|
}
|
||||||
|
|
||||||
type context = t
|
type context = t
|
||||||
@ -49,6 +50,41 @@ let add_rewards ctxt rewards =
|
|||||||
let get_rewards ctxt = ctxt.rewards
|
let get_rewards ctxt = ctxt.rewards
|
||||||
let get_fees ctxt = ctxt.fees
|
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 *)
|
type error += Gas_limit_too_high (* `Permanent *)
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
@ -295,6 +331,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
|
|||||||
rewards = Tez_repr.zero ;
|
rewards = Tez_repr.zero ;
|
||||||
operation_gas = Unaccounted ;
|
operation_gas = Unaccounted ;
|
||||||
block_gas = constants.Constants_repr.hard_gas_limit_per_block ;
|
block_gas = constants.Constants_repr.hard_gas_limit_per_block ;
|
||||||
|
origination_nonce = None ;
|
||||||
}
|
}
|
||||||
|
|
||||||
let check_first_block ctxt =
|
let check_first_block ctxt =
|
||||||
@ -341,6 +378,7 @@ let register_resolvers enc resolve =
|
|||||||
rewards = Tez_repr.zero ;
|
rewards = Tez_repr.zero ;
|
||||||
block_gas = Constants_repr.default.hard_gas_limit_per_block ;
|
block_gas = Constants_repr.default.hard_gas_limit_per_block ;
|
||||||
operation_gas = Unaccounted ;
|
operation_gas = Unaccounted ;
|
||||||
|
origination_nonce = None ;
|
||||||
} in
|
} in
|
||||||
resolve faked_context str in
|
resolve faked_context str in
|
||||||
Context.register_resolver enc resolve
|
Context.register_resolver enc resolve
|
||||||
|
@ -82,6 +82,13 @@ val set_gas_unlimited: t -> t
|
|||||||
val gas_level: t -> Gas_repr.t
|
val gas_level: t -> Gas_repr.t
|
||||||
val block_gas_level: t -> Z.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} *************************************************)
|
(** {1 Generic accessors} *************************************************)
|
||||||
|
|
||||||
type key = string list
|
type key = string list
|
||||||
|
@ -81,60 +81,56 @@ type execution_trace =
|
|||||||
let rec interp
|
let rec interp
|
||||||
: type p r.
|
: type p r.
|
||||||
(?log: execution_trace ref ->
|
(?log: execution_trace ref ->
|
||||||
context -> Contract.origination_nonce ->
|
context ->
|
||||||
source: Contract.t -> payer:Contract.t -> self: Contract.t -> Tez.t ->
|
source: Contract.t -> payer:Contract.t -> self: Contract.t -> Tez.t ->
|
||||||
(p, r) lambda -> p ->
|
(p, r) lambda -> p ->
|
||||||
(r * context * Contract.origination_nonce) tzresult Lwt.t)
|
(r * context) tzresult Lwt.t)
|
||||||
= fun ?log ctxt origination ~source ~payer ~self amount (Lam (code, _)) arg ->
|
= fun ?log ctxt ~source ~payer ~self amount (Lam (code, _)) arg ->
|
||||||
let rec step
|
let rec step
|
||||||
: type b a.
|
: type b a.
|
||||||
Contract.origination_nonce -> context -> (b, a) descr -> b stack ->
|
context -> (b, a) descr -> b stack ->
|
||||||
(a stack * context * Contract.origination_nonce) tzresult Lwt.t =
|
(a stack * context) tzresult Lwt.t =
|
||||||
fun origination ctxt ({ instr ; loc ; _ } as descr) stack ->
|
fun ctxt ({ instr ; loc ; _ } as descr) stack ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.cycle) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.cycle) >>=? fun ctxt ->
|
||||||
let logged_return : type a b.
|
let logged_return : type a b.
|
||||||
(b, a) descr ->
|
(b, a) descr ->
|
||||||
?origination:Contract.origination_nonce ->
|
|
||||||
a stack * context ->
|
a stack * context ->
|
||||||
(a stack * context * Contract.origination_nonce) tzresult Lwt.t =
|
(a stack * context) tzresult Lwt.t =
|
||||||
fun descr ?(origination = origination) (ret, ctxt) ->
|
fun descr (ret, ctxt) ->
|
||||||
match log with
|
match log with
|
||||||
| None -> return (ret, ctxt, origination)
|
| None -> return (ret, ctxt)
|
||||||
| Some log ->
|
| Some log ->
|
||||||
log := (descr.loc, Gas.level ctxt, unparse_stack ctxt (ret, descr.aft)) :: !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.
|
let consume_gas_terop : type ret arg1 arg2 arg3 rest.
|
||||||
?origination:Contract.origination_nonce ->
|
|
||||||
(_ * (_ * (_ * rest)), ret * rest) descr ->
|
(_ * (_ * (_ * rest)), ret * rest) descr ->
|
||||||
((arg1 -> arg2 -> arg3 -> ret) * arg1 * arg2 * arg3) ->
|
((arg1 -> arg2 -> arg3 -> ret) * arg1 * arg2 * arg3) ->
|
||||||
(arg1 -> arg2 -> arg3 -> Gas.cost) ->
|
(arg1 -> arg2 -> arg3 -> Gas.cost) ->
|
||||||
rest stack ->
|
rest stack ->
|
||||||
((ret * rest) stack * context * Contract.origination_nonce) tzresult Lwt.t =
|
((ret * rest) stack * context) tzresult Lwt.t =
|
||||||
fun ?(origination = origination) descr (op, x1, x2, x3) cost_func rest ->
|
fun descr (op, x1, x2, x3) cost_func rest ->
|
||||||
Lwt.return (Gas.consume ctxt (cost_func x1 x2 x3)) >>=? fun ctxt ->
|
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.
|
let consume_gas_binop : type ret arg1 arg2 rest.
|
||||||
?origination:Contract.origination_nonce ->
|
|
||||||
(_ * (_ * rest), ret * rest) descr ->
|
(_ * (_ * rest), ret * rest) descr ->
|
||||||
((arg1 -> arg2 -> ret) * arg1 * arg2) ->
|
((arg1 -> arg2 -> ret) * arg1 * arg2) ->
|
||||||
(arg1 -> arg2 -> Gas.cost) ->
|
(arg1 -> arg2 -> Gas.cost) ->
|
||||||
rest stack ->
|
rest stack ->
|
||||||
context ->
|
context ->
|
||||||
((ret * rest) stack * context * Contract.origination_nonce) tzresult Lwt.t =
|
((ret * rest) stack * context) tzresult Lwt.t =
|
||||||
fun ?(origination = origination) descr (op, x1, x2) cost_func rest ctxt ->
|
fun descr (op, x1, x2) cost_func rest ctxt ->
|
||||||
Lwt.return (Gas.consume ctxt (cost_func x1 x2)) >>=? fun 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.
|
let consume_gas_unop : type ret arg rest.
|
||||||
?origination:Contract.origination_nonce ->
|
|
||||||
(_ * rest, ret * rest) descr ->
|
(_ * rest, ret * rest) descr ->
|
||||||
((arg -> ret) * arg) ->
|
((arg -> ret) * arg) ->
|
||||||
(arg -> Gas.cost) ->
|
(arg -> Gas.cost) ->
|
||||||
rest stack ->
|
rest stack ->
|
||||||
context ->
|
context ->
|
||||||
((ret * rest) stack * context * Contract.origination_nonce) tzresult Lwt.t =
|
((ret * rest) stack * context) tzresult Lwt.t =
|
||||||
fun ?(origination = origination) descr (op, arg) cost_func rest ctxt ->
|
fun descr (op, arg) cost_func rest ctxt ->
|
||||||
Lwt.return (Gas.consume ctxt (cost_func arg)) >>=? fun 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 :
|
let consume_gaz_comparison :
|
||||||
type t rest.
|
type t rest.
|
||||||
(t * (t * rest), Script_int.z Script_int.num * rest) descr ->
|
(t * (t * rest), Script_int.z Script_int.num * rest) descr ->
|
||||||
@ -142,9 +138,7 @@ let rec interp
|
|||||||
(t -> t -> Gas.cost) ->
|
(t -> t -> Gas.cost) ->
|
||||||
t -> t ->
|
t -> t ->
|
||||||
rest stack ->
|
rest stack ->
|
||||||
((Script_int.z Script_int.num * rest) stack
|
((Script_int.z Script_int.num * rest) stack * context) tzresult Lwt.t =
|
||||||
* context
|
|
||||||
* Contract.origination_nonce) tzresult Lwt.t =
|
|
||||||
fun descr op cost x1 x2 rest ->
|
fun descr op cost x1 x2 rest ->
|
||||||
Lwt.return (Gas.consume ctxt (cost x1 x2)) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt (cost x1 x2)) >>=? fun ctxt ->
|
||||||
logged_return descr (Item (Script_int.of_int @@ op x1 x2, rest), ctxt) in
|
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 ->
|
delegatable:bool -> credit:Tez.t -> code:prim Micheline.canonical ->
|
||||||
init:storage -> param_type:param ty -> storage_type:storage ty ->
|
init:storage -> param_type:param ty -> storage_type:storage ty ->
|
||||||
rest:rest stack ->
|
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
|
fun descr ~manager ~delegate ~spendable ~delegatable
|
||||||
~credit ~code ~init ~param_type ~storage_type ~rest ->
|
~credit ~code ~init ~param_type ~storage_type ~rest ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.create_contract) >>=? fun ctxt ->
|
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
|
let storage = Micheline.strip_locations storage in
|
||||||
Contract.spend_from_script ctxt self credit >>=? fun ctxt ->
|
Contract.spend_from_script ctxt self credit >>=? fun ctxt ->
|
||||||
Contract.originate ctxt
|
Contract.originate ctxt
|
||||||
origination
|
|
||||||
~manager ~delegate ~balance:credit
|
~manager ~delegate ~balance:credit
|
||||||
~script:({ code ; storage }, None (* TODO: initialize a big map from a map *))
|
~script:({ code ; storage }, None (* TODO: initialize a big map from a map *))
|
||||||
~spendable ~delegatable
|
~spendable ~delegatable
|
||||||
>>=? fun (ctxt, contract, origination) ->
|
>>=? fun (ctxt, contract) ->
|
||||||
Fees.origination_burn ctxt ~payer contract >>=? fun ctxt ->
|
Fees.origination_burn ctxt ~payer contract >>=? fun ctxt ->
|
||||||
logged_return descr ~origination (Item ((param_type, contract), rest), ctxt) in
|
logged_return descr (Item ((param_type, contract), rest), ctxt) in
|
||||||
let logged_return : ?origination:Contract.origination_nonce ->
|
let logged_return :
|
||||||
a stack * context ->
|
a stack * context ->
|
||||||
(a stack * context * Contract.origination_nonce) tzresult Lwt.t =
|
(a stack * context) tzresult Lwt.t =
|
||||||
logged_return descr in
|
logged_return descr in
|
||||||
match instr, stack with
|
match instr, stack with
|
||||||
(* stack ops *)
|
(* stack ops *)
|
||||||
@ -202,10 +195,10 @@ let rec interp
|
|||||||
logged_return (Item (None, rest), ctxt)
|
logged_return (Item (None, rest), ctxt)
|
||||||
| If_none (bt, _), Item (None, rest) ->
|
| If_none (bt, _), Item (None, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
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) ->
|
| If_none (_, bf), Item (Some v, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
||||||
step origination ctxt bf (Item (v, rest))
|
step ctxt bf (Item (v, rest))
|
||||||
(* pairs *)
|
(* pairs *)
|
||||||
| Cons_pair, Item (a, Item (b, rest)) ->
|
| Cons_pair, Item (a, Item (b, rest)) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.pair) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.pair) >>=? fun ctxt ->
|
||||||
@ -225,10 +218,10 @@ let rec interp
|
|||||||
logged_return (Item (R v, rest), ctxt)
|
logged_return (Item (R v, rest), ctxt)
|
||||||
| If_left (bt, _), Item (L v, rest) ->
|
| If_left (bt, _), Item (L v, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
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) ->
|
| If_left (_, bf), Item (R v, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
||||||
step origination ctxt bf (Item (v, rest))
|
step ctxt bf (Item (v, rest))
|
||||||
(* lists *)
|
(* lists *)
|
||||||
| Cons_list, Item (hd, Item (tl, rest)) ->
|
| Cons_list, Item (hd, Item (tl, rest)) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.cons) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.cons) >>=? fun ctxt ->
|
||||||
@ -238,43 +231,43 @@ let rec interp
|
|||||||
logged_return (Item ([], rest), ctxt)
|
logged_return (Item ([], rest), ctxt)
|
||||||
| If_cons (_, bf), Item ([], rest) ->
|
| If_cons (_, bf), Item ([], rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
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) ->
|
| If_cons (bt, _), Item (hd :: tl, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
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)) ->
|
| 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 ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
match l with
|
match l with
|
||||||
| [] -> return (List.rev acc, ctxt, origination)
|
| [] -> return (List.rev acc, ctxt)
|
||||||
| hd :: tl ->
|
| hd :: tl ->
|
||||||
interp ?log ctxt origination ~source ~payer ~self amount lam hd
|
interp ?log ctxt ~source ~payer ~self amount lam hd
|
||||||
>>=? fun (hd, ctxt, origination) ->
|
>>=? fun (hd, ctxt) ->
|
||||||
loop rest ctxt origination tl (hd :: acc)
|
loop rest ctxt tl (hd :: acc)
|
||||||
in loop rest ctxt origination l [] >>=? fun (res, ctxt, origination) ->
|
in loop rest ctxt l [] >>=? fun (res, ctxt) ->
|
||||||
logged_return ~origination (Item (res, rest), ctxt)
|
logged_return (Item (res, rest), ctxt)
|
||||||
| List_map_body body, Item (l, rest) ->
|
| 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 ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
match l with
|
match l with
|
||||||
| [] -> return (Item (List.rev acc, rest), ctxt, origination)
|
| [] -> return (Item (List.rev acc, rest), ctxt)
|
||||||
| hd :: tl ->
|
| hd :: tl ->
|
||||||
step origination ctxt body (Item (hd, rest))
|
step ctxt body (Item (hd, rest))
|
||||||
>>=? fun (Item (hd, rest), ctxt, origination) ->
|
>>=? fun (Item (hd, rest), ctxt) ->
|
||||||
loop rest ctxt origination tl (hd :: acc)
|
loop rest ctxt tl (hd :: acc)
|
||||||
in loop rest ctxt origination l [] >>=? fun (res, ctxt, origination) ->
|
in loop rest ctxt l [] >>=? fun (res, ctxt) ->
|
||||||
logged_return ~origination (res, ctxt)
|
logged_return (res, ctxt)
|
||||||
| List_reduce, Item (lam, Item (l, Item (init, rest))) ->
|
| 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 ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
match l with
|
match l with
|
||||||
| [] -> return (acc, ctxt, origination)
|
| [] -> return (acc, ctxt)
|
||||||
| hd :: tl ->
|
| hd :: tl ->
|
||||||
interp ?log ctxt origination ~source ~payer ~self amount lam (hd, acc)
|
interp ?log ctxt ~source ~payer ~self amount lam (hd, acc)
|
||||||
>>=? fun (acc, ctxt, origination) ->
|
>>=? fun (acc, ctxt) ->
|
||||||
loop rest ctxt origination tl acc
|
loop rest ctxt tl acc
|
||||||
in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) ->
|
in loop rest ctxt l init >>=? fun (res, ctxt) ->
|
||||||
logged_return ~origination (Item (res, rest), ctxt)
|
logged_return (Item (res, rest), ctxt)
|
||||||
| List_size, Item (list, rest) ->
|
| List_size, Item (list, rest) ->
|
||||||
Lwt.return
|
Lwt.return
|
||||||
(List.fold_left
|
(List.fold_left
|
||||||
@ -285,16 +278,16 @@ let rec interp
|
|||||||
(ok (0, ctxt)) list) >>=? fun (len, ctxt) ->
|
(ok (0, ctxt)) list) >>=? fun (len, ctxt) ->
|
||||||
logged_return (Item (Script_int.(abs (of_int len)), rest), ctxt)
|
logged_return (Item (Script_int.(abs (of_int len)), rest), ctxt)
|
||||||
| List_iter body, Item (l, init) ->
|
| 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 ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
match l with
|
match l with
|
||||||
| [] -> return (stack, ctxt, origination)
|
| [] -> return (stack, ctxt)
|
||||||
| hd :: tl ->
|
| hd :: tl ->
|
||||||
step origination ctxt body (Item (hd, stack))
|
step ctxt body (Item (hd, stack))
|
||||||
>>=? fun (stack, ctxt, origination) ->
|
>>=? fun (stack, ctxt) ->
|
||||||
loop ctxt origination tl stack
|
loop ctxt tl stack
|
||||||
in loop ctxt origination l init >>=? fun (res, ctxt, origination) ->
|
in loop ctxt l init >>=? fun (res, ctxt) ->
|
||||||
logged_return ~origination (res, ctxt)
|
logged_return (res, ctxt)
|
||||||
(* sets *)
|
(* sets *)
|
||||||
| Empty_set t, rest ->
|
| Empty_set t, rest ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.empty_set) >>=? fun ctxt ->
|
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))) ->
|
| Set_reduce, Item (lam, Item (set, Item (init, rest))) ->
|
||||||
Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set)) >>=? fun ctxt ->
|
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 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 ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
match l with
|
match l with
|
||||||
| [] -> return (acc, ctxt, origination)
|
| [] -> return (acc, ctxt)
|
||||||
| hd :: tl ->
|
| hd :: tl ->
|
||||||
interp ?log ctxt origination ~source ~payer ~self amount lam (hd, acc)
|
interp ?log ctxt ~source ~payer ~self amount lam (hd, acc)
|
||||||
>>=? fun (acc, ctxt, origination) ->
|
>>=? fun (acc, ctxt) ->
|
||||||
loop rest ctxt origination tl acc
|
loop rest ctxt tl acc
|
||||||
in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) ->
|
in loop rest ctxt l init >>=? fun (res, ctxt) ->
|
||||||
logged_return ~origination (Item (res, rest), ctxt)
|
logged_return (Item (res, rest), ctxt)
|
||||||
| Set_iter body, Item (set, init) ->
|
| Set_iter body, Item (set, init) ->
|
||||||
Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set)) >>=? fun ctxt ->
|
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 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 ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
match l with
|
match l with
|
||||||
| [] -> return (stack, ctxt, origination)
|
| [] -> return (stack, ctxt)
|
||||||
| hd :: tl ->
|
| hd :: tl ->
|
||||||
step origination ctxt body (Item (hd, stack))
|
step ctxt body (Item (hd, stack))
|
||||||
>>=? fun (stack, ctxt, origination) ->
|
>>=? fun (stack, ctxt) ->
|
||||||
loop ctxt origination tl stack
|
loop ctxt tl stack
|
||||||
in loop ctxt origination l init >>=? fun (res, ctxt, origination) ->
|
in loop ctxt l init >>=? fun (res, ctxt) ->
|
||||||
logged_return ~origination (res, ctxt)
|
logged_return (res, ctxt)
|
||||||
| Set_mem, Item (v, Item (set, rest)) ->
|
| Set_mem, Item (v, Item (set, rest)) ->
|
||||||
consume_gas_binop descr (set_mem, v, set) Interp_costs.set_mem rest ctxt
|
consume_gas_binop descr (set_mem, v, set) Interp_costs.set_mem rest ctxt
|
||||||
| Set_update, Item (v, Item (presence, Item (set, rest))) ->
|
| Set_update, Item (v, Item (presence, Item (set, rest))) ->
|
||||||
@ -338,42 +331,42 @@ let rec interp
|
|||||||
| Map_map, Item (lam, Item (map, rest)) ->
|
| Map_map, Item (lam, Item (map, rest)) ->
|
||||||
Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->
|
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 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 ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
match l with
|
match l with
|
||||||
| [] -> return (acc, ctxt, origination)
|
| [] -> return (acc, ctxt)
|
||||||
| (k, _) as hd :: tl ->
|
| (k, _) as hd :: tl ->
|
||||||
interp ?log ctxt origination ~source ~payer ~self amount lam hd
|
interp ?log ctxt ~source ~payer ~self amount lam hd
|
||||||
>>=? fun (hd, ctxt, origination) ->
|
>>=? fun (hd, ctxt) ->
|
||||||
loop rest ctxt origination tl (map_update k (Some hd) acc)
|
loop rest ctxt tl (map_update k (Some hd) acc)
|
||||||
in loop rest ctxt origination l (empty_map (map_key_ty map)) >>=? fun (res, ctxt, origination) ->
|
in loop rest ctxt l (empty_map (map_key_ty map)) >>=? fun (res, ctxt) ->
|
||||||
logged_return ~origination (Item (res, rest), ctxt)
|
logged_return (Item (res, rest), ctxt)
|
||||||
| Map_reduce, Item (lam, Item (map, Item (init, rest))) ->
|
| Map_reduce, Item (lam, Item (map, Item (init, rest))) ->
|
||||||
Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->
|
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 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 ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
match l with
|
match l with
|
||||||
| [] -> return (acc, ctxt, origination)
|
| [] -> return (acc, ctxt)
|
||||||
| hd :: tl ->
|
| hd :: tl ->
|
||||||
interp ?log ctxt origination ~source ~payer ~self amount lam (hd, acc)
|
interp ?log ctxt ~source ~payer ~self amount lam (hd, acc)
|
||||||
>>=? fun (acc, ctxt, origination) ->
|
>>=? fun (acc, ctxt) ->
|
||||||
loop rest ctxt origination tl acc
|
loop rest ctxt tl acc
|
||||||
in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) ->
|
in loop rest ctxt l init >>=? fun (res, ctxt) ->
|
||||||
logged_return ~origination (Item (res, rest), ctxt)
|
logged_return (Item (res, rest), ctxt)
|
||||||
| Map_iter body, Item (map, init) ->
|
| Map_iter body, Item (map, init) ->
|
||||||
Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->
|
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 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 ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
match l with
|
match l with
|
||||||
| [] -> return (stack, ctxt, origination)
|
| [] -> return (stack, ctxt)
|
||||||
| hd :: tl ->
|
| hd :: tl ->
|
||||||
step origination ctxt body (Item (hd, stack))
|
step ctxt body (Item (hd, stack))
|
||||||
>>=? fun (stack, ctxt, origination) ->
|
>>=? fun (stack, ctxt) ->
|
||||||
loop ctxt origination tl stack
|
loop ctxt tl stack
|
||||||
in loop ctxt origination l init >>=? fun (res, ctxt, origination) ->
|
in loop ctxt l init >>=? fun (res, ctxt) ->
|
||||||
logged_return ~origination (res, ctxt)
|
logged_return (res, ctxt)
|
||||||
| Map_mem, Item (v, Item (map, rest)) ->
|
| Map_mem, Item (v, Item (map, rest)) ->
|
||||||
consume_gas_binop descr (map_mem, v, map) Interp_costs.map_mem rest ctxt
|
consume_gas_binop descr (map_mem, v, map) Interp_costs.map_mem rest ctxt
|
||||||
| Map_get, Item (v, Item (map, rest)) ->
|
| 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
|
consume_gas_unop descr (Script_int.lognot, x) Interp_costs.lognot rest ctxt
|
||||||
(* control *)
|
(* control *)
|
||||||
| Seq (hd, tl), stack ->
|
| Seq (hd, tl), stack ->
|
||||||
step origination ctxt hd stack >>=? fun (trans, ctxt, origination) ->
|
step ctxt hd stack >>=? fun (trans, ctxt) ->
|
||||||
step origination ctxt tl trans
|
step ctxt tl trans
|
||||||
| If (bt, _), Item (true, rest) ->
|
| If (bt, _), Item (true, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
||||||
step origination ctxt bt rest
|
step ctxt bt rest
|
||||||
| If (_, bf), Item (false, rest) ->
|
| If (_, bf), Item (false, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
|
||||||
step origination ctxt bf rest
|
step ctxt bf rest
|
||||||
| Loop body, Item (true, rest) ->
|
| Loop body, Item (true, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
step origination ctxt body rest >>=? fun (trans, ctxt, origination) ->
|
step ctxt body rest >>=? fun (trans, ctxt) ->
|
||||||
step origination ctxt descr trans
|
step ctxt descr trans
|
||||||
| Loop _, Item (false, rest) ->
|
| Loop _, Item (false, rest) ->
|
||||||
logged_return (rest, ctxt)
|
logged_return (rest, ctxt)
|
||||||
| Loop_left body, Item (L v, rest) ->
|
| Loop_left body, Item (L v, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
step origination ctxt body (Item (v, rest)) >>=? fun (trans, ctxt, origination) ->
|
step ctxt body (Item (v, rest)) >>=? fun (trans, ctxt) ->
|
||||||
step origination ctxt descr trans
|
step ctxt descr trans
|
||||||
| Loop_left _, Item (R v, rest) ->
|
| Loop_left _, Item (R v, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
|
||||||
logged_return (Item (v, rest), ctxt)
|
logged_return (Item (v, rest), ctxt)
|
||||||
| Dip b, Item (ign, rest) ->
|
| Dip b, Item (ign, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->
|
||||||
step origination ctxt b rest >>=? fun (res, ctxt, origination) ->
|
step ctxt b rest >>=? fun (res, ctxt) ->
|
||||||
logged_return ~origination (Item (ign, res), ctxt)
|
logged_return (Item (ign, res), ctxt)
|
||||||
| Exec, Item (arg, Item (lam, rest)) ->
|
| Exec, Item (arg, Item (lam, rest)) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.exec) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.exec) >>=? fun ctxt ->
|
||||||
interp ?log ctxt origination ~source ~payer ~self amount lam arg >>=? fun (res, ctxt, origination) ->
|
interp ?log ctxt ~source ~payer ~self amount lam arg >>=? fun (res, ctxt) ->
|
||||||
logged_return ~origination (Item (res, rest), ctxt)
|
logged_return (Item (res, rest), ctxt)
|
||||||
| Lambda lam, rest ->
|
| Lambda lam, rest ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
|
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, _ ->
|
||||||
fail (Reject loc)
|
fail (Reject loc)
|
||||||
| Nop, stack ->
|
| Nop, stack ->
|
||||||
@ -681,11 +674,10 @@ let rec interp
|
|||||||
Contract.spend_from_script ctxt self credit >>=? fun ctxt ->
|
Contract.spend_from_script ctxt self credit >>=? fun ctxt ->
|
||||||
Lwt.return Tez.(credit -? Constants.origination_burn ctxt) >>=? fun balance ->
|
Lwt.return Tez.(credit -? Constants.origination_burn ctxt) >>=? fun balance ->
|
||||||
Contract.originate ctxt
|
Contract.originate ctxt
|
||||||
origination
|
|
||||||
~manager ~delegate ~balance
|
~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 ->
|
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) ->
|
| Implicit_account, Item (key, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt ->
|
||||||
let contract = Contract.implicit_contract key in
|
let contract = Contract.implicit_contract key in
|
||||||
@ -750,36 +742,35 @@ let rec interp
|
|||||||
| Some log ->
|
| Some log ->
|
||||||
log := (code.loc, Gas.level ctxt, unparse_stack ctxt (stack, code.bef)) :: !log
|
log := (code.loc, Gas.level ctxt, unparse_stack ctxt (stack, code.bef)) :: !log
|
||||||
end ;
|
end ;
|
||||||
step origination ctxt code stack >>=? fun (Item (ret, Empty), ctxt, origination) ->
|
step ctxt code stack >>=? fun (Item (ret, Empty), ctxt) ->
|
||||||
return (ret, ctxt, origination)
|
return (ret, ctxt)
|
||||||
|
|
||||||
(* ---- contract handling ---------------------------------------------------*)
|
(* ---- contract handling ---------------------------------------------------*)
|
||||||
|
|
||||||
and execute ?log ctxt ~check_operations origination_nonce ~source ~payer ~self script amount arg :
|
and execute ?log ctxt ~check_operations ~source ~payer ~self script amount arg :
|
||||||
(Script.expr * internal_operation list * context * Contract.origination_nonce *
|
(Script.expr * internal_operation list * context *
|
||||||
Script_typed_ir.ex_big_map option) tzresult Lwt.t =
|
Script_typed_ir.ex_big_map option) tzresult Lwt.t =
|
||||||
parse_script ctxt ~check_operations script
|
parse_script ctxt ~check_operations script
|
||||||
>>=? fun ((Ex_script { code ; arg_type ; storage ; storage_type }), ctxt) ->
|
>>=? fun ((Ex_script { code ; arg_type ; storage ; storage_type }), ctxt) ->
|
||||||
parse_data ctxt ~check_operations arg_type arg >>=? fun (arg, ctxt) ->
|
parse_data ctxt ~check_operations arg_type arg >>=? fun (arg, ctxt) ->
|
||||||
trace
|
trace
|
||||||
(Runtime_contract_error (self, script.code))
|
(Runtime_contract_error (self, script.code))
|
||||||
(interp ?log ctxt origination_nonce ~source ~payer ~self amount code (arg, storage))
|
(interp ?log ctxt ~source ~payer ~self amount code (arg, storage))
|
||||||
>>=? fun ((ops, sto), ctxt, origination) ->
|
>>=? fun ((ops, sto), ctxt) ->
|
||||||
Lwt.return @@ unparse_data ctxt storage_type sto >>=? fun (storage, 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)
|
Script_ir_translator.extract_big_map storage_type sto)
|
||||||
|
|
||||||
type execution_result =
|
type execution_result =
|
||||||
{ ctxt : context ;
|
{ ctxt : context ;
|
||||||
origination_nonce : Contract.origination_nonce ;
|
|
||||||
storage : Script.expr ;
|
storage : Script.expr ;
|
||||||
big_map_diff : Contract.big_map_diff option ;
|
big_map_diff : Contract.big_map_diff option ;
|
||||||
operations : internal_operation list }
|
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
|
let log = ref [] in
|
||||||
execute ~log ctxt ~check_operations origination_nonce ~source ~payer ~self script amount (Micheline.root parameter)
|
execute ~log ctxt ~check_operations ~source ~payer ~self script amount (Micheline.root parameter)
|
||||||
>>=? fun (storage, operations, ctxt, origination_nonce, big_map_diff) ->
|
>>=? fun (storage, operations, ctxt, big_map_diff) ->
|
||||||
begin match big_map_diff with
|
begin match big_map_diff with
|
||||||
| None -> return (None, ctxt)
|
| None -> return (None, ctxt)
|
||||||
| Some big_map_diff ->
|
| 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)
|
return (Some big_map_diff, ctxt)
|
||||||
end >>=? fun (big_map_diff, ctxt) ->
|
end >>=? fun (big_map_diff, ctxt) ->
|
||||||
let trace = List.rev !log in
|
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 =
|
let execute ctxt ~check_operations ~source ~payer ~self:(self, script) ~parameter ~amount =
|
||||||
execute ctxt origination_nonce ~check_operations ~source ~payer ~self script amount (Micheline.root parameter)
|
execute ctxt ~check_operations ~source ~payer ~self script amount (Micheline.root parameter)
|
||||||
>>=? fun (storage, operations, ctxt, origination_nonce, big_map_diff) ->
|
>>=? fun (storage, operations, ctxt, big_map_diff) ->
|
||||||
begin match big_map_diff with
|
begin match big_map_diff with
|
||||||
| None -> return (None, ctxt)
|
| None -> return (None, ctxt)
|
||||||
| Some big_map_diff ->
|
| Some big_map_diff ->
|
||||||
Script_ir_translator.to_serializable_big_map ctxt big_map_diff >>=? fun (big_map_diff, ctxt) ->
|
Script_ir_translator.to_serializable_big_map ctxt big_map_diff >>=? fun (big_map_diff, ctxt) ->
|
||||||
return (Some big_map_diff, ctxt)
|
return (Some big_map_diff, ctxt)
|
||||||
end >>=? fun (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 }
|
||||||
|
@ -15,13 +15,12 @@ type error += Runtime_contract_error : Contract.t * Script.expr -> error
|
|||||||
|
|
||||||
type execution_result =
|
type execution_result =
|
||||||
{ ctxt : context ;
|
{ ctxt : context ;
|
||||||
origination_nonce : Contract.origination_nonce ;
|
|
||||||
storage : Script.expr ;
|
storage : Script.expr ;
|
||||||
big_map_diff : Contract.big_map_diff option ;
|
big_map_diff : Contract.big_map_diff option ;
|
||||||
operations : internal_operation list }
|
operations : internal_operation list }
|
||||||
|
|
||||||
val execute:
|
val execute:
|
||||||
Alpha_context.t -> Contract.origination_nonce ->
|
Alpha_context.t ->
|
||||||
check_operations: bool ->
|
check_operations: bool ->
|
||||||
source: Contract.t ->
|
source: Contract.t ->
|
||||||
payer: Contract.t ->
|
payer: Contract.t ->
|
||||||
@ -34,7 +33,7 @@ type execution_trace =
|
|||||||
(Script.location * Gas.t * Script.expr list) list
|
(Script.location * Gas.t * Script.expr list) list
|
||||||
|
|
||||||
val trace:
|
val trace:
|
||||||
Alpha_context.t -> Contract.origination_nonce ->
|
Alpha_context.t ->
|
||||||
check_operations: bool ->
|
check_operations: bool ->
|
||||||
source: Contract.t ->
|
source: Contract.t ->
|
||||||
payer: Contract.t ->
|
payer: Contract.t ->
|
||||||
|
@ -20,8 +20,7 @@ let operation
|
|||||||
pred_block_hash
|
pred_block_hash
|
||||||
0
|
0
|
||||||
hash
|
hash
|
||||||
operation >>=? fun { ctxt = tc ; origination_nonce ; ignored_error } ->
|
operation >>=? fun { ctxt = tc ; contracts ; ignored_error } ->
|
||||||
let contracts = Proto_alpha.Alpha_context.Contract.originated_contracts origination_nonce in
|
|
||||||
return ((contracts, ignored_error), tc)
|
return ((contracts, ignored_error), tc)
|
||||||
|
|
||||||
|
|
||||||
|
@ -28,11 +28,11 @@ let execute_code_pred
|
|||||||
let apply_op = Helpers_operation.apply_of_proto
|
let apply_op = Helpers_operation.apply_of_proto
|
||||||
(Some op) op_header dummy_protop in
|
(Some op) op_header dummy_protop in
|
||||||
let hash = Operation.hash apply_op in
|
let hash = Operation.hash apply_op in
|
||||||
let dummy_nonce = Contract.initial_origination_nonce hash in
|
|
||||||
let amount = Tez.zero in
|
let amount = Tez.zero in
|
||||||
Lwt.return (Proto_alpha.Alpha_context.Gas.set_limit tc gas) >>=? fun tc ->
|
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
|
Script_interpreter.execute
|
||||||
tc dummy_nonce
|
tc
|
||||||
~check_operations: true
|
~check_operations: true
|
||||||
~source: op.contract
|
~source: op.contract
|
||||||
~payer: op.contract
|
~payer: op.contract
|
||||||
|
@ -61,8 +61,7 @@ let test_simple_activation () =
|
|||||||
Proto_alpha.Apply.apply_anonymous_operation
|
Proto_alpha.Apply.apply_anonymous_operation
|
||||||
starting_block.tezos_context
|
starting_block.tezos_context
|
||||||
None
|
None
|
||||||
starting_block.hash
|
activation_operation >>=? fun ctxt ->
|
||||||
activation_operation >>=? fun (ctxt, _) ->
|
|
||||||
|
|
||||||
let contract = Contract.implicit_contract pkh in
|
let contract = Contract.implicit_contract pkh in
|
||||||
|
|
||||||
|
@ -48,12 +48,11 @@ let parse_execute sb ?tc code_str param_str storage_str =
|
|||||||
let param = parse_param param_str in
|
let param = parse_param param_str in
|
||||||
let script = parse_script code_str storage_str in
|
let script = parse_script code_str storage_str in
|
||||||
Script.execute_code_pred ?tc sb script param
|
Script.execute_code_pred ?tc sb script param
|
||||||
>>=?? fun (dst, { ctxt = tc ; operations = ops ;
|
>>=?? fun (dst, { ctxt = tc ; operations = ops ; big_map_diff = bgm }) ->
|
||||||
origination_nonce = nonce ; big_map_diff = bgm }) ->
|
|
||||||
let payer =
|
let payer =
|
||||||
(List.hd Account.bootstrap_accounts).contract in
|
(List.hd Account.bootstrap_accounts).contract in
|
||||||
Proto_alpha.Apply.apply_internal_manager_operations tc ~payer nonce ops >>=?? fun (tc, nonce, err, _, ops) ->
|
Proto_alpha.Apply.apply_internal_manager_operations tc ~payer ops >>=?? fun (tc, err, _, ops) ->
|
||||||
let contracts = Contract.originated_contracts nonce in
|
Contract.originated_from_current_nonce tc >>=?? fun contracts ->
|
||||||
match err with
|
match err with
|
||||||
| None ->
|
| None ->
|
||||||
let tc = Proto_alpha.Alpha_context.Gas.set_unlimited tc in
|
let tc = Proto_alpha.Alpha_context.Gas.set_unlimited tc in
|
||||||
|
Loading…
Reference in New Issue
Block a user