Alpha: IO gas accounting

This commit is contained in:
Benjamin Canou 2018-04-07 18:28:37 +02:00 committed by Grégoire Henry
parent 4a0b30d968
commit 6f3be375e8
15 changed files with 155 additions and 83 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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