Alpha: IO gas accounting
This commit is contained in:
parent
4a0b30d968
commit
6f3be375e8
@ -502,9 +502,9 @@ module Contract : sig
|
|||||||
val is_spendable:
|
val is_spendable:
|
||||||
context -> contract -> bool tzresult Lwt.t
|
context -> contract -> bool tzresult Lwt.t
|
||||||
val get_script:
|
val get_script:
|
||||||
context -> contract -> (Script.t option) tzresult Lwt.t
|
context -> contract -> (context * Script.t option) tzresult Lwt.t
|
||||||
val get_storage:
|
val get_storage:
|
||||||
context -> contract -> (Script.expr option) tzresult Lwt.t
|
context -> contract -> (context * Script.expr option) tzresult Lwt.t
|
||||||
|
|
||||||
val get_counter: context -> contract -> int32 tzresult Lwt.t
|
val get_counter: context -> contract -> int32 tzresult Lwt.t
|
||||||
val get_balance:
|
val get_balance:
|
||||||
@ -546,13 +546,13 @@ module Contract : sig
|
|||||||
|
|
||||||
module Big_map : sig
|
module Big_map : sig
|
||||||
val set:
|
val set:
|
||||||
context -> contract ->
|
context -> contract -> string -> Script.expr -> context tzresult Lwt.t
|
||||||
string -> Script.expr -> context tzresult Lwt.t
|
|
||||||
val remove:
|
val remove:
|
||||||
context -> contract -> string -> context tzresult Lwt.t
|
context -> contract -> string -> context tzresult Lwt.t
|
||||||
val mem: context -> contract -> string -> bool Lwt.t
|
val mem:
|
||||||
|
context -> contract -> string -> (context * bool) tzresult Lwt.t
|
||||||
val get_opt:
|
val get_opt:
|
||||||
context -> contract -> string -> Script_repr.expr option tzresult Lwt.t
|
context -> contract -> string -> (context * Script_repr.expr option) tzresult Lwt.t
|
||||||
end
|
end
|
||||||
|
|
||||||
end
|
end
|
||||||
|
@ -376,7 +376,7 @@ let apply_manager_operation_content
|
|||||||
begin
|
begin
|
||||||
Contract.spend ctxt source amount >>=? fun ctxt ->
|
Contract.spend ctxt source amount >>=? fun ctxt ->
|
||||||
Contract.credit ctxt destination amount >>=? fun ctxt ->
|
Contract.credit ctxt destination amount >>=? fun ctxt ->
|
||||||
Contract.get_script ctxt destination >>=? function
|
Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with
|
||||||
| None -> begin
|
| None -> begin
|
||||||
match parameters with
|
match parameters with
|
||||||
| None ->
|
| None ->
|
||||||
|
@ -170,8 +170,10 @@ let () =
|
|||||||
register_field S.counter Contract.get_counter ;
|
register_field S.counter Contract.get_counter ;
|
||||||
register_field S.spendable Contract.is_spendable ;
|
register_field S.spendable Contract.is_spendable ;
|
||||||
register_field S.delegatable Contract.is_delegatable ;
|
register_field S.delegatable Contract.is_delegatable ;
|
||||||
register_opt_field S.script Contract.get_script ;
|
register_opt_field S.script
|
||||||
register_opt_field S.storage Contract.get_storage ;
|
(fun c v -> Contract.get_script c v >>=? fun (_, v) -> return v) ;
|
||||||
|
register_opt_field S.storage
|
||||||
|
(fun c v -> Contract.get_storage c v >>=? fun (_, v) -> return v) ;
|
||||||
register_field S.info (fun ctxt contract ->
|
register_field S.info (fun ctxt contract ->
|
||||||
Contract.get_balance ctxt contract >>=? fun balance ->
|
Contract.get_balance ctxt contract >>=? fun balance ->
|
||||||
Contract.get_manager ctxt contract >>=? fun manager ->
|
Contract.get_manager ctxt contract >>=? fun manager ->
|
||||||
@ -179,8 +181,8 @@ let () =
|
|||||||
Contract.get_counter ctxt contract >>=? fun counter ->
|
Contract.get_counter ctxt contract >>=? fun counter ->
|
||||||
Contract.is_delegatable ctxt contract >>=? fun delegatable ->
|
Contract.is_delegatable ctxt contract >>=? fun delegatable ->
|
||||||
Contract.is_spendable ctxt contract >>=? fun spendable ->
|
Contract.is_spendable ctxt contract >>=? fun spendable ->
|
||||||
Contract.get_script ctxt contract >>=? fun script ->
|
Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
|
||||||
Contract.get_storage ctxt contract >>=? fun storage ->
|
Contract.get_storage ctxt contract >>=? fun (_ctxt, storage) ->
|
||||||
return { manager ; balance ;
|
return { manager ; balance ;
|
||||||
spendable ; delegate = (delegatable, delegate) ;
|
spendable ; delegate = (delegatable, delegate) ;
|
||||||
script ; counter ; storage})
|
script ; counter ; storage})
|
||||||
|
@ -200,8 +200,8 @@ let create_base c contract
|
|||||||
Storage.Contract.Counter.init c contract counter >>=? fun c ->
|
Storage.Contract.Counter.init c contract counter >>=? fun c ->
|
||||||
(match script with
|
(match script with
|
||||||
| Some ({ Script_repr.code ; storage }, (code_fees, storage_fees)) ->
|
| Some ({ Script_repr.code ; storage }, (code_fees, storage_fees)) ->
|
||||||
Storage.Contract.Code.init c contract code >>=? fun c ->
|
Storage.Contract.Code.init c contract code >>=? fun (c, _) ->
|
||||||
Storage.Contract.Storage.init c contract storage >>=? fun c ->
|
Storage.Contract.Storage.init c contract storage >>=? fun (c, _) ->
|
||||||
Storage.Contract.Code_fees.init c contract code_fees >>=? fun c ->
|
Storage.Contract.Code_fees.init c contract code_fees >>=? fun c ->
|
||||||
Storage.Contract.Storage_fees.init c contract storage_fees
|
Storage.Contract.Storage_fees.init c contract storage_fees
|
||||||
| None ->
|
| None ->
|
||||||
@ -225,11 +225,11 @@ let delete c contract =
|
|||||||
Storage.Contract.Spendable.del c contract >>= fun c ->
|
Storage.Contract.Spendable.del c contract >>= fun c ->
|
||||||
Storage.Contract.Delegatable.del c contract >>= fun c ->
|
Storage.Contract.Delegatable.del c contract >>= fun c ->
|
||||||
Storage.Contract.Counter.delete c contract >>=? fun c ->
|
Storage.Contract.Counter.delete c contract >>=? fun c ->
|
||||||
Storage.Contract.Code.remove c contract >>= fun c ->
|
Storage.Contract.Code.remove c contract >>=? fun (c, _) ->
|
||||||
Storage.Contract.Storage.remove c contract >>= fun c ->
|
Storage.Contract.Storage.remove c contract >>=? fun (c, _) ->
|
||||||
Storage.Contract.Code_fees.remove c contract >>= fun c ->
|
Storage.Contract.Code_fees.remove c contract >>= fun c ->
|
||||||
Storage.Contract.Storage_fees.remove c contract >>= fun c ->
|
Storage.Contract.Storage_fees.remove c contract >>= fun c ->
|
||||||
Storage.Contract.Big_map.clear (c, contract) >>= fun c ->
|
Storage.Contract.Big_map.clear (c, contract) >>=? fun c ->
|
||||||
return c
|
return c
|
||||||
|
|
||||||
let allocated c contract =
|
let allocated c contract =
|
||||||
@ -274,11 +274,11 @@ let increment_counter c contract =
|
|||||||
Storage.Contract.Counter.set c contract (Int32.succ contract_counter)
|
Storage.Contract.Counter.set c contract (Int32.succ contract_counter)
|
||||||
|
|
||||||
let get_script c contract =
|
let get_script c contract =
|
||||||
Storage.Contract.Code.get_option c contract >>=? fun code ->
|
Storage.Contract.Code.get_option c contract >>=? fun (c, code) ->
|
||||||
Storage.Contract.Storage.get_option c contract >>=? fun storage ->
|
Storage.Contract.Storage.get_option c contract >>=? fun (c, storage) ->
|
||||||
match code, storage with
|
match code, storage with
|
||||||
| None, None -> return None
|
| None, None -> return (c, None)
|
||||||
| Some code, Some storage -> return (Some { Script_repr.code ; storage })
|
| Some code, Some storage -> return (c, Some { Script_repr.code ; storage })
|
||||||
| None, Some _ | Some _, None -> failwith "get_script"
|
| None, Some _ | Some _, None -> failwith "get_script"
|
||||||
|
|
||||||
let get_storage = Storage.Contract.Storage.get_option
|
let get_storage = Storage.Contract.Storage.get_option
|
||||||
@ -364,14 +364,15 @@ let update_script_storage c contract storage big_map =
|
|||||||
fold_left_s (fun c (key, value) ->
|
fold_left_s (fun c (key, value) ->
|
||||||
match value with
|
match value with
|
||||||
| None ->
|
| None ->
|
||||||
Storage.Contract.Big_map.remove (c, contract) key >>=
|
Storage.Contract.Big_map.remove (c, contract) key >>=? fun (c, _) ->
|
||||||
return
|
return c
|
||||||
| Some v ->
|
| Some v ->
|
||||||
Storage.Contract.Big_map.init_set (c, contract) key v >>=
|
Storage.Contract.Big_map.init_set (c, contract) key v >>=? fun (c, _) ->
|
||||||
return)
|
return c)
|
||||||
c diff
|
c diff
|
||||||
end >>=? fun c ->
|
end >>=? fun c ->
|
||||||
Storage.Contract.Storage.set c contract storage
|
Storage.Contract.Storage.set c contract storage >>=? fun (c, _) ->
|
||||||
|
return c
|
||||||
|
|
||||||
let spend_from_script c contract amount =
|
let spend_from_script c contract amount =
|
||||||
Storage.Contract.Balance.get c contract >>=? fun balance ->
|
Storage.Contract.Balance.get c contract >>=? fun balance ->
|
||||||
@ -393,16 +394,18 @@ let spend_from_script c contract amount =
|
|||||||
return c
|
return c
|
||||||
| None ->
|
| None ->
|
||||||
(* Delete empty implicit contract *)
|
(* Delete empty implicit contract *)
|
||||||
delete c contract
|
delete c contract >>=? fun (c, _) ->
|
||||||
|
return c
|
||||||
|
|
||||||
let credit c contract amount =
|
let credit c contract amount =
|
||||||
begin
|
begin
|
||||||
if Tez_repr.(amount <> Tez_repr.zero) then
|
if Tez_repr.(amount <> Tez_repr.zero) then
|
||||||
return ()
|
return c
|
||||||
else
|
else
|
||||||
Storage.Contract.Code.mem c contract >>= fun target_has_code ->
|
Storage.Contract.Code.mem c contract >>=? fun (c, target_has_code) ->
|
||||||
fail_unless target_has_code (Empty_transaction contract)
|
fail_unless target_has_code (Empty_transaction contract) >>=? fun () ->
|
||||||
end >>=? fun () ->
|
return c
|
||||||
|
end >>=? fun c ->
|
||||||
Storage.Contract.Balance.get_option c contract >>=? function
|
Storage.Contract.Balance.get_option c contract >>=? function
|
||||||
| None -> begin
|
| None -> begin
|
||||||
match Contract_repr.is_implicit contract with
|
match Contract_repr.is_implicit contract with
|
||||||
@ -440,8 +443,13 @@ let init c =
|
|||||||
|
|
||||||
module Big_map = struct
|
module Big_map = struct
|
||||||
let set ctxt contract key value =
|
let set ctxt contract key value =
|
||||||
Storage.Contract.Big_map.init_set (ctxt, contract) key value >>= return
|
Storage.Contract.Big_map.init_set (ctxt, contract) key value >>=? fun (c, _) ->
|
||||||
let remove ctxt contract = Storage.Contract.Big_map.delete (ctxt, contract)
|
return c
|
||||||
let mem ctxt contract = Storage.Contract.Big_map.mem (ctxt, contract)
|
let remove ctxt contract key =
|
||||||
let get_opt ctxt contract = Storage.Contract.Big_map.get_option (ctxt, contract)
|
Storage.Contract.Big_map.delete (ctxt, contract) key >>=? fun (c, _) ->
|
||||||
|
return c
|
||||||
|
let mem ctxt contract key =
|
||||||
|
Storage.Contract.Big_map.mem (ctxt, contract) key
|
||||||
|
let get_opt ctxt contract key =
|
||||||
|
Storage.Contract.Big_map.get_option (ctxt, contract) key
|
||||||
end
|
end
|
||||||
|
@ -56,9 +56,9 @@ val get_balance: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
|
|||||||
val get_counter: Raw_context.t -> Contract_repr.t -> int32 tzresult Lwt.t
|
val get_counter: Raw_context.t -> Contract_repr.t -> int32 tzresult Lwt.t
|
||||||
|
|
||||||
val get_script:
|
val get_script:
|
||||||
Raw_context.t -> Contract_repr.t -> Script_repr.t option tzresult Lwt.t
|
Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.t option) tzresult Lwt.t
|
||||||
val get_storage:
|
val get_storage:
|
||||||
Raw_context.t -> Contract_repr.t -> Script_repr.expr option tzresult Lwt.t
|
Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
|
||||||
|
|
||||||
type big_map_diff = (string * Script_repr.expr option) list
|
type big_map_diff = (string * Script_repr.expr option) list
|
||||||
|
|
||||||
@ -103,11 +103,11 @@ val init:
|
|||||||
|
|
||||||
module Big_map : sig
|
module Big_map : sig
|
||||||
val set :
|
val set :
|
||||||
Raw_context.t -> Contract_repr.t ->
|
Raw_context.t -> Contract_repr.t -> string -> Script_repr.expr -> Raw_context.t tzresult Lwt.t
|
||||||
string -> Script_repr.expr -> Raw_context.t tzresult Lwt.t
|
|
||||||
val remove :
|
val remove :
|
||||||
Raw_context.t -> Contract_repr.t -> string -> Raw_context.t tzresult Lwt.t
|
Raw_context.t -> Contract_repr.t -> string -> Raw_context.t tzresult Lwt.t
|
||||||
val mem : Raw_context.t -> Contract_repr.t -> string -> bool Lwt.t
|
val mem :
|
||||||
|
Raw_context.t -> Contract_repr.t -> string -> (Raw_context.t * bool) tzresult Lwt.t
|
||||||
val get_opt :
|
val get_opt :
|
||||||
Raw_context.t -> Contract_repr.t -> string -> Script_repr.expr option tzresult Lwt.t
|
Raw_context.t -> Contract_repr.t -> string -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
|
||||||
end
|
end
|
||||||
|
@ -13,7 +13,11 @@ type t =
|
|||||||
|
|
||||||
type cost =
|
type cost =
|
||||||
{ allocations : Z.t ;
|
{ allocations : Z.t ;
|
||||||
steps : Z.t }
|
steps : Z.t ;
|
||||||
|
reads : Z.t ;
|
||||||
|
writes : Z.t ;
|
||||||
|
bytes_read : Z.t ;
|
||||||
|
bytes_written : Z.t }
|
||||||
|
|
||||||
let encoding =
|
let encoding =
|
||||||
let open Data_encoding in
|
let open Data_encoding in
|
||||||
@ -34,32 +38,53 @@ let pp ppf = function
|
|||||||
let cost_encoding =
|
let cost_encoding =
|
||||||
let open Data_encoding in
|
let open Data_encoding in
|
||||||
conv
|
conv
|
||||||
(fun { allocations ; steps } ->
|
(fun { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } ->
|
||||||
(allocations, steps))
|
(allocations, steps, reads, writes, bytes_read, bytes_written))
|
||||||
(fun (allocations, steps) ->
|
(fun (allocations, steps, reads, writes, bytes_read, bytes_written) ->
|
||||||
{ allocations ; steps })
|
{ allocations ; steps ; reads ; writes ; bytes_read ; bytes_written })
|
||||||
(obj2
|
(obj6
|
||||||
(req "allocations" z)
|
(req "allocations" z)
|
||||||
(req "steps" z))
|
(req "steps" z)
|
||||||
|
(req "reads" z)
|
||||||
|
(req "writes" z)
|
||||||
|
(req "bytes_read" z)
|
||||||
|
(req "bytes_written" z))
|
||||||
|
|
||||||
let pp_cost ppf { allocations ; steps } =
|
let pp_cost ppf { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } =
|
||||||
Format.fprintf ppf
|
Format.fprintf ppf
|
||||||
"(steps: %s, allocs: %s)"
|
"(steps: %s, allocs: %s, reads: %s (%s bytes), writes: %s (%s bytes))"
|
||||||
(Z.to_string steps) (Z.to_string allocations)
|
(Z.to_string steps)
|
||||||
|
(Z.to_string allocations)
|
||||||
|
(Z.to_string reads)
|
||||||
|
(Z.to_string bytes_read)
|
||||||
|
(Z.to_string writes)
|
||||||
|
(Z.to_string bytes_written)
|
||||||
|
|
||||||
type error += Block_quota_exceeded (* `Temporary *)
|
type error += Block_quota_exceeded (* `Temporary *)
|
||||||
type error += Operation_quota_exceeded (* `Temporary *)
|
type error += Operation_quota_exceeded (* `Temporary *)
|
||||||
|
|
||||||
let allocation_weight = Z.of_int 2
|
let allocation_weight = Z.of_int 2 (* FIXME: placeholder *)
|
||||||
let step_weight = Z.of_int 1
|
let step_weight = Z.of_int 1 (* FIXME: placeholder *)
|
||||||
|
let read_base_weight = Z.of_int 10 (* FIXME: placeholder *)
|
||||||
|
let write_base_weight = Z.of_int 20 (* FIXME: placeholder *)
|
||||||
|
let byte_read_weight = Z.of_int 10 (* FIXME: placeholder *)
|
||||||
|
let byte_written_weight = Z.of_int 20 (* FIXME: placeholder *)
|
||||||
|
|
||||||
let consume block_gas operation_gas cost = match operation_gas with
|
let consume block_gas operation_gas cost = match operation_gas with
|
||||||
| Unaccounted -> ok (block_gas, Unaccounted)
|
| Unaccounted -> ok (block_gas, Unaccounted)
|
||||||
| Limited { remaining } ->
|
| Limited { remaining } ->
|
||||||
let weighted_cost =
|
let weighted_cost =
|
||||||
Z.add
|
Z.add
|
||||||
|
(Z.add
|
||||||
(Z.mul allocation_weight cost.allocations)
|
(Z.mul allocation_weight cost.allocations)
|
||||||
(Z.mul step_weight cost.steps) in
|
(Z.mul step_weight cost.steps))
|
||||||
|
(Z.add
|
||||||
|
(Z.add
|
||||||
|
(Z.mul read_base_weight cost.reads)
|
||||||
|
(Z.mul write_base_weight cost.writes))
|
||||||
|
(Z.add
|
||||||
|
(Z.mul byte_read_weight cost.bytes_read)
|
||||||
|
(Z.mul byte_written_weight cost.bytes_written))) in
|
||||||
let remaining =
|
let remaining =
|
||||||
Z.sub remaining weighted_cost in
|
Z.sub remaining weighted_cost in
|
||||||
let block_remaining =
|
let block_remaining =
|
||||||
@ -72,7 +97,11 @@ let consume block_gas operation_gas cost = match operation_gas with
|
|||||||
|
|
||||||
let alloc_cost n =
|
let alloc_cost n =
|
||||||
{ allocations = Z.of_int (n + 1) ;
|
{ allocations = Z.of_int (n + 1) ;
|
||||||
steps = Z.zero }
|
steps = Z.zero ;
|
||||||
|
reads = Z.zero ;
|
||||||
|
writes = Z.zero ;
|
||||||
|
bytes_read = Z.zero ;
|
||||||
|
bytes_written = Z.zero }
|
||||||
|
|
||||||
let alloc_bytes_cost n =
|
let alloc_bytes_cost n =
|
||||||
alloc_cost (n / 8)
|
alloc_cost (n / 8)
|
||||||
@ -82,19 +111,51 @@ let alloc_bits_cost n =
|
|||||||
|
|
||||||
let step_cost n =
|
let step_cost n =
|
||||||
{ allocations = Z.zero ;
|
{ allocations = Z.zero ;
|
||||||
steps = Z.of_int n }
|
steps = Z.of_int n ;
|
||||||
|
reads = Z.zero ;
|
||||||
|
writes = Z.zero ;
|
||||||
|
bytes_read = Z.zero ;
|
||||||
|
bytes_written = Z.zero }
|
||||||
|
|
||||||
let free =
|
let free =
|
||||||
{ allocations = Z.zero ;
|
{ allocations = Z.zero ;
|
||||||
steps = Z.zero }
|
steps = Z.zero ;
|
||||||
|
reads = Z.zero ;
|
||||||
|
writes = Z.zero ;
|
||||||
|
bytes_read = Z.zero ;
|
||||||
|
bytes_written = Z.zero }
|
||||||
|
|
||||||
|
let read_bytes_cost n =
|
||||||
|
{ allocations = Z.zero ;
|
||||||
|
steps = Z.zero ;
|
||||||
|
reads = Z.one ;
|
||||||
|
writes = Z.zero ;
|
||||||
|
bytes_read = n ;
|
||||||
|
bytes_written = Z.zero }
|
||||||
|
|
||||||
|
let write_bytes_cost n =
|
||||||
|
{ allocations = Z.zero ;
|
||||||
|
steps = Z.zero ;
|
||||||
|
reads = Z.zero ;
|
||||||
|
writes = Z.one ;
|
||||||
|
bytes_read = Z.zero ;
|
||||||
|
bytes_written = n }
|
||||||
|
|
||||||
let ( +@ ) x y =
|
let ( +@ ) x y =
|
||||||
{ allocations = Z.add x.allocations y.allocations ;
|
{ allocations = Z.add x.allocations y.allocations ;
|
||||||
steps = Z.add x.steps y.steps }
|
steps = Z.add x.steps y.steps ;
|
||||||
|
reads = Z.add x.reads y.reads ;
|
||||||
|
writes = Z.add x.writes y.writes ;
|
||||||
|
bytes_read = Z.add x.bytes_read y.bytes_read ;
|
||||||
|
bytes_written = Z.add x.bytes_written y.bytes_written }
|
||||||
|
|
||||||
let ( *@ ) x y =
|
let ( *@ ) x y =
|
||||||
{ allocations = Z.mul (Z.of_int x) y.allocations ;
|
{ allocations = Z.mul (Z.of_int x) y.allocations ;
|
||||||
steps = Z.mul (Z.of_int x) y.steps }
|
steps = Z.mul (Z.of_int x) y.steps ;
|
||||||
|
reads = Z.mul (Z.of_int x) y.reads ;
|
||||||
|
writes = Z.mul (Z.of_int x) y.writes ;
|
||||||
|
bytes_read = Z.mul (Z.of_int x) y.bytes_read ;
|
||||||
|
bytes_written = Z.mul (Z.of_int x) y.bytes_written }
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
let open Data_encoding in
|
let open Data_encoding in
|
||||||
|
@ -29,6 +29,8 @@ val step_cost : int -> cost
|
|||||||
val alloc_cost : int -> cost
|
val alloc_cost : int -> cost
|
||||||
val alloc_bytes_cost : int -> cost
|
val alloc_bytes_cost : int -> cost
|
||||||
val alloc_bits_cost : int -> cost
|
val alloc_bits_cost : int -> cost
|
||||||
|
val read_bytes_cost : Z.t -> cost
|
||||||
|
val write_bytes_cost : Z.t -> cost
|
||||||
|
|
||||||
val ( *@ ) : int -> cost -> cost
|
val ( *@ ) : int -> cost -> cost
|
||||||
val ( +@ ) : cost -> cost -> cost
|
val ( +@ ) : cost -> cost -> cost
|
||||||
|
@ -77,7 +77,6 @@ type error += Gas_limit_too_high (* `Permanent *)
|
|||||||
|
|
||||||
val set_gas_limit: t -> Z.t -> t tzresult
|
val set_gas_limit: t -> Z.t -> t tzresult
|
||||||
val set_gas_unlimited: t -> t
|
val set_gas_unlimited: t -> t
|
||||||
val consume_gas: t -> Gas_repr.cost -> t tzresult
|
|
||||||
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
|
||||||
|
|
||||||
|
@ -648,7 +648,7 @@ let rec interp
|
|||||||
Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->
|
||||||
Contract.spend_from_script ctxt source amount >>=? fun ctxt ->
|
Contract.spend_from_script ctxt source amount >>=? fun ctxt ->
|
||||||
Contract.credit ctxt destination amount >>=? fun ctxt ->
|
Contract.credit ctxt destination amount >>=? fun ctxt ->
|
||||||
Contract.get_script ctxt destination >>=? fun destination_script ->
|
Contract.get_script ctxt destination >>=? fun (ctxt, destination_script) ->
|
||||||
Lwt.return (unparse_data ctxt storage_type storage) >>=? fun (sto, ctxt) ->
|
Lwt.return (unparse_data ctxt storage_type storage) >>=? fun (sto, ctxt) ->
|
||||||
let sto = Micheline.strip_locations sto in
|
let sto = Micheline.strip_locations sto in
|
||||||
begin match Script_ir_translator.extract_big_map storage_type storage with
|
begin match Script_ir_translator.extract_big_map storage_type storage with
|
||||||
@ -685,7 +685,7 @@ let rec interp
|
|||||||
destination dummy_storage_fee >>=? fun ctxt ->
|
destination dummy_storage_fee >>=? fun ctxt ->
|
||||||
return (ctxt, origination)
|
return (ctxt, origination)
|
||||||
end >>=? fun (ctxt, origination) ->
|
end >>=? fun (ctxt, origination) ->
|
||||||
Contract.get_script ctxt source >>=? (function
|
Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with
|
||||||
| None -> assert false
|
| None -> assert false
|
||||||
| Some { storage; _ } ->
|
| Some { storage; _ } ->
|
||||||
parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) ->
|
parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) ->
|
||||||
@ -696,7 +696,7 @@ let rec interp
|
|||||||
Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->
|
||||||
Contract.spend_from_script ctxt source amount >>=? fun ctxt ->
|
Contract.spend_from_script ctxt source amount >>=? fun ctxt ->
|
||||||
Contract.credit ctxt destination amount >>=? fun ctxt ->
|
Contract.credit ctxt destination amount >>=? fun ctxt ->
|
||||||
Contract.get_script ctxt destination >>=? function
|
Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with
|
||||||
| None -> fail (Invalid_contract (loc, destination))
|
| None -> fail (Invalid_contract (loc, destination))
|
||||||
| Some script ->
|
| Some script ->
|
||||||
begin match extract_big_map storage_type sto with
|
begin match extract_big_map storage_type sto with
|
||||||
@ -727,7 +727,7 @@ let rec interp
|
|||||||
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) ->
|
||||||
Contract.get_script ctxt source >>=? (function
|
Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with
|
||||||
| None -> assert false
|
| None -> assert false
|
||||||
| Some { storage ; _ } ->
|
| Some { storage ; _ } ->
|
||||||
parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) ->
|
parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) ->
|
||||||
|
@ -2159,7 +2159,7 @@ and parse_contract
|
|||||||
Lwt.return (Gas.consume ctxt Typecheck_costs.get_script) >>=? fun ctxt ->
|
Lwt.return (Gas.consume ctxt Typecheck_costs.get_script) >>=? fun ctxt ->
|
||||||
trace
|
trace
|
||||||
(Invalid_contract (loc, contract)) @@
|
(Invalid_contract (loc, contract)) @@
|
||||||
Contract.get_script ctxt contract >>=? function
|
Contract.get_script ctxt contract >>=? fun (ctxt, script) -> match script with
|
||||||
| None ->
|
| None ->
|
||||||
Lwt.return
|
Lwt.return
|
||||||
(ty_eq arg Unit_t >>? fun Eq ->
|
(ty_eq arg Unit_t >>? fun Eq ->
|
||||||
@ -2303,7 +2303,7 @@ let hash_data ctxt typ data =
|
|||||||
let big_map_mem ctxt contract key { diff ; key_type ; _ } =
|
let big_map_mem ctxt contract key { diff ; key_type ; _ } =
|
||||||
match map_get key diff with
|
match map_get key diff with
|
||||||
| None -> Lwt.return @@ hash_data ctxt key_type key >>=? fun (hash, ctxt) ->
|
| None -> Lwt.return @@ hash_data ctxt key_type key >>=? fun (hash, ctxt) ->
|
||||||
Alpha_context.Contract.Big_map.mem ctxt contract hash >>= fun res ->
|
Alpha_context.Contract.Big_map.mem ctxt contract hash >>=? fun (ctxt, res) ->
|
||||||
return (res, ctxt)
|
return (res, ctxt)
|
||||||
| Some None -> return (false, ctxt)
|
| Some None -> return (false, ctxt)
|
||||||
| Some (Some _) -> return (true, ctxt)
|
| Some (Some _) -> return (true, ctxt)
|
||||||
@ -2315,10 +2315,10 @@ let big_map_get ctxt contract key { diff ; key_type ; value_type } =
|
|||||||
Lwt.return @@ hash_data ctxt key_type key >>=? fun (hash, ctxt) ->
|
Lwt.return @@ hash_data ctxt key_type key >>=? fun (hash, ctxt) ->
|
||||||
Alpha_context.Contract.Big_map.get_opt
|
Alpha_context.Contract.Big_map.get_opt
|
||||||
ctxt contract hash >>=? begin function
|
ctxt contract hash >>=? begin function
|
||||||
| None -> return (None, ctxt)
|
| (ctxt, None) -> return (None, ctxt)
|
||||||
| Some value ->
|
| (ctxt, Some value) ->
|
||||||
parse_data ctxt value_type (Micheline.root value) >>|? fun (x, ctxt) ->
|
parse_data ctxt value_type (Micheline.root value) >>=? fun (x, ctxt) ->
|
||||||
(Some x, ctxt)
|
return (Some x, ctxt)
|
||||||
end
|
end
|
||||||
|
|
||||||
let big_map_update key value ({ diff ; _ } as map) =
|
let big_map_update key value ({ diff ; _ } as map) =
|
||||||
|
@ -127,17 +127,17 @@ module Contract = struct
|
|||||||
(Make_value(Int32))
|
(Make_value(Int32))
|
||||||
|
|
||||||
module Code =
|
module Code =
|
||||||
Indexed_context.Make_map
|
Indexed_context.Make_carbonated_map
|
||||||
(struct let name = ["code"] end)
|
(struct let name = ["code"] end)
|
||||||
(Make_value(struct
|
(Make_carbonated_value(struct
|
||||||
type t = Script_repr.expr
|
type t = Script_repr.expr
|
||||||
let encoding = Script_repr.expr_encoding
|
let encoding = Script_repr.expr_encoding
|
||||||
end))
|
end))
|
||||||
|
|
||||||
module Storage =
|
module Storage =
|
||||||
Indexed_context.Make_map
|
Indexed_context.Make_carbonated_map
|
||||||
(struct let name = ["storage"] end)
|
(struct let name = ["storage"] end)
|
||||||
(Make_value(struct
|
(Make_carbonated_value(struct
|
||||||
type t = Script_repr.expr
|
type t = Script_repr.expr
|
||||||
let encoding = Script_repr.expr_encoding
|
let encoding = Script_repr.expr_encoding
|
||||||
end))
|
end))
|
||||||
@ -145,12 +145,12 @@ module Contract = struct
|
|||||||
type bigmap_key = Raw_context.t * Contract_repr.t
|
type bigmap_key = Raw_context.t * Contract_repr.t
|
||||||
|
|
||||||
module Big_map =
|
module Big_map =
|
||||||
Storage_functors.Make_indexed_data_storage
|
Storage_functors.Make_indexed_carbonated_data_storage
|
||||||
(Make_subcontext
|
(Make_subcontext
|
||||||
(Indexed_context.Raw_context)
|
(Indexed_context.Raw_context)
|
||||||
(struct let name = ["big_map"] end))
|
(struct let name = ["big_map"] end))
|
||||||
(String_index)
|
(String_index)
|
||||||
(Make_value (struct
|
(Make_carbonated_value (struct
|
||||||
type t = Script_repr.expr
|
type t = Script_repr.expr
|
||||||
let encoding = Script_repr.expr_encoding
|
let encoding = Script_repr.expr_encoding
|
||||||
end))
|
end))
|
||||||
|
@ -156,12 +156,12 @@ module Contract : sig
|
|||||||
and type value = int32
|
and type value = int32
|
||||||
and type t := Raw_context.t
|
and type t := Raw_context.t
|
||||||
|
|
||||||
module Code : Indexed_data_storage
|
module Code : Indexed_carbonated_data_storage
|
||||||
with type key = Contract_repr.t
|
with type key = Contract_repr.t
|
||||||
and type value = Script_repr.expr
|
and type value = Script_repr.expr
|
||||||
and type t := Raw_context.t
|
and type t := Raw_context.t
|
||||||
|
|
||||||
module Storage : Indexed_data_storage
|
module Storage : Indexed_carbonated_data_storage
|
||||||
with type key = Contract_repr.t
|
with type key = Contract_repr.t
|
||||||
and type value = Script_repr.expr
|
and type value = Script_repr.expr
|
||||||
and type t := Raw_context.t
|
and type t := Raw_context.t
|
||||||
@ -178,7 +178,7 @@ module Contract : sig
|
|||||||
|
|
||||||
type bigmap_key = Raw_context.t * Contract_repr.t
|
type bigmap_key = Raw_context.t * Contract_repr.t
|
||||||
|
|
||||||
module Big_map : Indexed_data_storage
|
module Big_map : Indexed_carbonated_data_storage
|
||||||
with type key = string
|
with type key = string
|
||||||
and type value = Script_repr.expr
|
and type value = Script_repr.expr
|
||||||
and type t := bigmap_key
|
and type t := bigmap_key
|
||||||
|
@ -48,7 +48,7 @@ let rec len_name = function
|
|||||||
|
|
||||||
let encode_len_value bytes =
|
let encode_len_value bytes =
|
||||||
let length = MBytes.length bytes in
|
let length = MBytes.length bytes in
|
||||||
Data_encoding.(Binary.to_bytes int31) length
|
Data_encoding.(Binary.to_bytes_exn int31) length
|
||||||
|
|
||||||
let decode_len_value key len =
|
let decode_len_value key len =
|
||||||
match Data_encoding.(Binary.of_bytes int31) len with
|
match Data_encoding.(Binary.of_bytes int31) len with
|
||||||
|
@ -46,8 +46,8 @@ let expect_big_map tc contract print_key key_type print_data data_type contents
|
|||||||
let open Proto_alpha.Error_monad in
|
let open Proto_alpha.Error_monad in
|
||||||
iter_p
|
iter_p
|
||||||
(fun (n, exp) ->
|
(fun (n, exp) ->
|
||||||
Lwt.return @@ Proto_alpha.Script_ir_translator.hash_data tc key_type n >>=? fun (key, _tc) ->
|
Lwt.return @@ Proto_alpha.Script_ir_translator.hash_data tc key_type n >>=? fun (key, tc) ->
|
||||||
Proto_alpha.Alpha_context.Contract.Big_map.get_opt tc contract key >>=? fun data ->
|
Proto_alpha.Alpha_context.Contract.Big_map.get_opt tc contract key >>=? fun (_tc, data) ->
|
||||||
match data, exp with
|
match data, exp with
|
||||||
| None, None ->
|
| None, None ->
|
||||||
debug " - big_map[%a] is not defined (ok)" print_key n ;
|
debug " - big_map[%a] is not defined (ok)" print_key n ;
|
||||||
|
@ -434,7 +434,7 @@ let test_example () =
|
|||||||
test_contract ~tc "create_contract" account_str account_str >>=? fun (cs, tc) ->
|
test_contract ~tc "create_contract" account_str account_str >>=? fun (cs, tc) ->
|
||||||
Assert.equal_int 1 @@ List.length cs ;
|
Assert.equal_int 1 @@ List.length cs ;
|
||||||
let contract = List.hd cs in
|
let contract = List.hd cs in
|
||||||
Proto_alpha.Alpha_context.Contract.get_script tc contract >>=?? fun res ->
|
Proto_alpha.Alpha_context.Contract.get_script tc contract >>=?? fun (_, res) ->
|
||||||
let script = Option.unopt_exn (Failure "get_script") res in
|
let script = Option.unopt_exn (Failure "get_script") res in
|
||||||
Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, ret, _, _, _) ->
|
Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, ret, _, _, _) ->
|
||||||
Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon ret ;
|
Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon ret ;
|
||||||
|
Loading…
Reference in New Issue
Block a user