Alpha: thread origination_nonce in the context

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

View File

@ -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

View File

@ -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

View File

@ -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 }

View File

@ -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

View File

@ -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

View File

@ -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 ()

View File

@ -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

View File

@ -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

View File

@ -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 }

View File

@ -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 ->

View File

@ -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)

View File

@ -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

View File

@ -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

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 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