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

Alpha: add result record type for apply operation and include storage fees

Browse Source
This commit is contained in:
Benjamin Canou 2018-04-08 02:07:39 +02:00 committed by Grégoire Henry
parent 25a1930c32
commit 42899ccb09
7 changed files with 53 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -370,7 +370,7 @@ let apply_amendment_operation_content ctxt delegate = function
let apply_manager_operation_content let apply_manager_operation_content
ctxt origination_nonce source = function ctxt origination_nonce source = function
| Reveal _ -> return (ctxt, origination_nonce, None) | Reveal _ -> return (ctxt, origination_nonce, None, Tez.zero)
| Transaction { amount ; parameters ; destination ; gas_limit } -> | Transaction { amount ; parameters ; destination ; gas_limit } ->
Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt -> Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
begin begin
@ -380,11 +380,11 @@ let apply_manager_operation_content
| None -> begin | None -> begin
match parameters with match parameters with
| None -> | None ->
return (ctxt, origination_nonce, None) return (ctxt, origination_nonce, 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) return (ctxt, origination_nonce, None, Tez.zero)
| _ -> fail (Bad_contract_parameter (destination, None, parameters)) | _ -> fail (Bad_contract_parameter (destination, None, parameters))
end end
| Some script -> | Some script ->
@ -402,10 +402,10 @@ let apply_manager_operation_content
Contract.update_script_storage Contract.update_script_storage
ctxt destination ctxt destination
storage_res diff >>=? fun ctxt -> storage_res diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source destination >>=? fun ctxt -> Fees.update_script_storage ctxt ~source destination >>=? fun (ctxt, fees) ->
return (ctxt, origination_nonce, None) return (ctxt, origination_nonce, None, fees)
| Error err -> | Error err ->
return (ctxt, origination_nonce, Some err) in return (ctxt, origination_nonce, 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))) return (ctxt, origination_nonce, 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
@ -447,10 +447,10 @@ let apply_manager_operation_content
Contract.Big_map.set ctxt contract key v) Contract.Big_map.set ctxt contract key v)
ctxt diff ctxt diff
end >>=? fun ctxt -> end >>=? fun ctxt ->
return (ctxt, origination_nonce, None) return (ctxt, origination_nonce, 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) return (ctxt, origination_nonce, None, Tez.zero)
let apply_sourced_operation let apply_sourced_operation
ctxt pred_block block_prio ctxt pred_block block_prio
@ -477,39 +477,42 @@ let apply_sourced_operation
Contract.increment_counter ctxt source >>=? fun ctxt -> Contract.increment_counter ctxt source >>=? fun ctxt ->
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 ->
fold_left_s (fun (ctxt, origination_nonce, err) content -> fold_left_s (fun (ctxt, origination_nonce, err, storage_fees) content ->
match err with match err with
| Some _ -> return (ctxt, origination_nonce, err) | Some _ -> return (ctxt, origination_nonce, err, Tez.zero)
| None -> | None ->
Contract.must_exist ctxt source >>=? fun () -> Contract.must_exist ctxt source >>=? fun () ->
apply_manager_operation_content apply_manager_operation_content
ctxt origination_nonce source content) ctxt origination_nonce source content
(ctxt, origination_nonce, None) contents >>=? fun (ctxt, origination_nonce, err, operation_storage_fees) ->
>>=? fun (ctxt, origination_nonce, err) -> Lwt.return Tez.(storage_fees +? operation_storage_fees) >>=? fun storage_fees ->
return (ctxt, origination_nonce, err) return (ctxt, origination_nonce, err, storage_fees))
(ctxt, origination_nonce, None, Tez.zero) contents
>>=? fun (ctxt, origination_nonce, err,storage_fees) ->
return (ctxt, origination_nonce, err, storage_fees)
| 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) return (ctxt, origination_nonce, 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) return (ctxt, origination_nonce, 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) return (ctxt, origination_nonce, 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) return (ctxt, origination_nonce, None, Tez.zero)
let apply_anonymous_operation ctxt _delegate origination_nonce kind = let apply_anonymous_operation ctxt _delegate origination_nonce kind =
match kind with match kind with
@ -611,6 +614,15 @@ let apply_anonymous_operation ctxt _delegate origination_nonce kind =
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, origination_nonce)
type operation_result =
{ ctxt : context ;
gas : Gas.t ;
origination_nonce : Contract.origination_nonce ;
ignored_error : error list option ;
fees : Tez.t ;
rewards : Tez.t ;
storage_fees : Tez.t }
let apply_operation let apply_operation
ctxt delegate pred_block block_prio hash operation = ctxt delegate pred_block block_prio hash operation =
begin match operation.contents with begin match operation.contents with
@ -621,17 +633,18 @@ let apply_operation
apply_anonymous_operation ctxt delegate origination_nonce op) apply_anonymous_operation ctxt delegate origination_nonce op)
(ctxt, origination_nonce) ops (ctxt, origination_nonce) ops
>>=? fun (ctxt, origination_nonce) -> >>=? fun (ctxt, origination_nonce) ->
return (ctxt, Contract.originated_contracts origination_nonce, None) return (ctxt, origination_nonce, None, Tez.zero)
| Sourced_operations op -> | Sourced_operations op ->
let origination_nonce = Contract.initial_origination_nonce hash in 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 >>=? fun (ctxt, origination_nonce, err) -> operation origination_nonce op
return (ctxt, Contract.originated_contracts origination_nonce, err) end >>=? fun (ctxt, origination_nonce, ignored_error, storage_fees) ->
end >>=? fun (ctxt, contracts, err) ->
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, contracts, err) return { ctxt ; gas ; origination_nonce ; ignored_error ; storage_fees ;
fees = Alpha_context.get_fees ctxt ;
rewards = Alpha_context.get_rewards ctxt }
let may_snapshot_roll ctxt = let may_snapshot_roll ctxt =
let level = Alpha_context.Level.current ctxt in let level = Alpha_context.Level.current ctxt in

5
src/proto_alpha/lib_protocol/src/fees.ml
View File

@ -37,9 +37,10 @@ let update_script_storage c ~source contract =
match Tez.(fees -? paid_fees) with match Tez.(fees -? paid_fees) with
| Error _ -> | Error _ ->
(* Previously paid fees are greater than required fees. *) (* Previously paid fees are greater than required fees. *)
return c return (c, Tez.zero)
| Ok to_be_paid -> | Ok to_be_paid ->
(* Burning the fees... *) (* Burning the fees... *)
trace Cannot_pay_storage_fee trace Cannot_pay_storage_fee
(Contract.spend_from_script c source to_be_paid >>=? fun c -> (Contract.spend_from_script c source to_be_paid >>=? fun c ->
Contract.add_to_paid_fees c contract to_be_paid) Contract.add_to_paid_fees c contract to_be_paid) >>=? fun c ->
return (c, to_be_paid)

2
src/proto_alpha/lib_protocol/src/fees.mli
View File

@ -17,5 +17,5 @@ val origination_burn:
val update_script_storage: val update_script_storage:
Alpha_context.t -> source:Contract.t -> Alpha_context.t -> source:Contract.t ->
Contract.t -> Alpha_context.t tzresult Lwt.t Contract.t -> (Alpha_context.t * Tez.t) tzresult Lwt.t

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

@ -151,8 +151,10 @@ module I = struct
Apply.apply_operation Apply.apply_operation
ctxt (Some baker_pkh) pred_block block_prio hash operation ctxt (Some baker_pkh) pred_block block_prio hash operation
>>=? function >>=? function
| (_ctxt, _, _, Some script_err) -> Lwt.return (Error script_err) | { ignored_error = Some script_err ; _ } -> Lwt.return (Error script_err)
| (_ctxt, gas, contracts, None) -> Lwt.return (Ok (contracts, gas)) | { gas ; origination_nonce ; _ } ->
let contracts = Contract.originated_contracts origination_nonce in
Lwt.return (Ok (contracts, gas))
let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) = let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) =

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

@ -116,7 +116,7 @@ let apply_operation ({ mode ; ctxt ; op_count ; _ } as data) operation =
Some baker in Some baker in
Apply.apply_operation ctxt baker pred_block block_prio Apply.apply_operation ctxt baker pred_block block_prio
(Alpha_context.Operation.hash operation) operation (Alpha_context.Operation.hash operation) operation
>>=? fun (ctxt, _gas, _contracts, _ignored_script_error) -> >>=? fun { Apply.ctxt ; _ } ->
let op_count = op_count + 1 in let op_count = op_count + 1 in
return { data with ctxt ; op_count } return { data with ctxt ; op_count }

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

@ -656,7 +656,7 @@ let rec interp
return (Some diff, ctxt) return (Some diff, ctxt)
end >>=? fun (diff, ctxt) -> end >>=? fun (diff, ctxt) ->
Contract.update_script_storage ctxt source sto diff >>=? fun ctxt -> Contract.update_script_storage ctxt source sto diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig source >>=? fun ctxt -> Fees.update_script_storage ctxt ~source:orig source >>=? fun (ctxt, _) ->
begin match destination_script with begin match destination_script with
| None -> | None ->
(* we see non scripted contracts as (unit, unit) contract *) (* we see non scripted contracts as (unit, unit) contract *)
@ -678,7 +678,7 @@ let rec interp
trace trace
(Invalid_contract (loc, destination)) (Invalid_contract (loc, destination))
(parse_data ctxt Unit_t ret) >>=? fun ((), ctxt) -> (parse_data ctxt Unit_t ret) >>=? fun ((), ctxt) ->
Fees.update_script_storage ctxt ~source:orig destination >>=? fun ctxt -> Fees.update_script_storage ctxt ~source:orig destination >>=? fun (ctxt, _) ->
return (ctxt, origination) return (ctxt, origination)
end >>=? fun (ctxt, origination) -> end >>=? fun (ctxt, origination) ->
Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with
@ -705,7 +705,7 @@ let rec interp
Lwt.return (unparse_data ctxt storage_type sto) >>=? fun (sto, ctxt) -> Lwt.return (unparse_data ctxt storage_type sto) >>=? fun (sto, ctxt) ->
let sto = Micheline.strip_locations sto in let sto = Micheline.strip_locations sto in
Contract.update_script_storage ctxt source sto maybe_diff >>=? fun ctxt -> Contract.update_script_storage ctxt source sto maybe_diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig source >>=? fun ctxt -> Fees.update_script_storage ctxt ~source:orig source >>=? fun (ctxt, _) ->
Lwt.return (unparse_data ctxt tp p) >>=? fun (p, ctxt) -> Lwt.return (unparse_data ctxt tp p) >>=? fun (p, ctxt) ->
execute origination source destination ctxt script amount p execute origination source destination ctxt script amount p
>>=? fun (sto, ret, ctxt, origination, maybe_diff) -> >>=? fun (sto, ret, ctxt, origination, maybe_diff) ->
@ -717,7 +717,7 @@ let rec interp
return (Some diff, ctxt) return (Some diff, ctxt)
end >>=? fun (diff, ctxt) -> end >>=? fun (diff, ctxt) ->
Contract.update_script_storage ctxt destination sto diff >>=? fun ctxt -> Contract.update_script_storage ctxt destination sto diff >>=? fun ctxt ->
Fees.update_script_storage ctxt ~source:orig destination >>=? fun ctxt -> Fees.update_script_storage ctxt ~source:orig destination >>=? fun (ctxt, _) ->
trace trace
(Invalid_contract (loc, destination)) (Invalid_contract (loc, destination))
(parse_data ctxt tr ret) >>=? fun (v, ctxt) -> (parse_data ctxt tr ret) >>=? fun (v, ctxt) ->

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

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