diff --git a/src/proto_alpha/lib_protocol/src/storage.ml b/src/proto_alpha/lib_protocol/src/storage.ml index a21026b7c..db8b010ea 100644 --- a/src/proto_alpha/lib_protocol/src/storage.ml +++ b/src/proto_alpha/lib_protocol/src/storage.ml @@ -48,7 +48,7 @@ module Last_block_priority = Make_single_data_storage (Raw_context) (struct let name = ["last_block_priority"] end) - (Make_value(Int)) + (Int) (** Contracts handling *) @@ -61,7 +61,7 @@ module Contract = struct Make_single_data_storage (Raw_context) (struct let name = ["global_counter"] end) - (Make_value(Int32)) + (Int32) module Indexed_context = Make_indexed_subcontext @@ -74,7 +74,7 @@ module Contract = struct module Balance = Indexed_context.Make_map (struct let name = ["balance"] end) - (Make_value(Tez_repr)) + (Tez_repr) module Frozen_balance_index = Make_indexed_subcontext @@ -86,22 +86,22 @@ module Contract = struct module Frozen_deposits = Frozen_balance_index.Make_map (struct let name = ["deposits"] end) - (Make_value(Tez_repr)) + (Tez_repr) module Frozen_fees = Frozen_balance_index.Make_map (struct let name = ["fees"] end) - (Make_value(Tez_repr)) + (Tez_repr) module Frozen_rewards = Frozen_balance_index.Make_map (struct let name = ["rewards"] end) - (Make_value(Tez_repr)) + (Tez_repr) module Manager = Indexed_context.Make_map (struct let name = ["manager"] end) - (Make_value(Manager_repr)) + (Manager_repr) module Spendable = Indexed_context.Make_set @@ -114,7 +114,7 @@ module Contract = struct module Delegate = Indexed_context.Make_map (struct let name = ["delegate"] end) - (Make_value(Signature.Public_key_hash)) + (Signature.Public_key_hash) module Inactive_delegate = Indexed_context.Make_set @@ -123,7 +123,7 @@ module Contract = struct module Delegate_desactivation = Indexed_context.Make_map (struct let name = ["delegate_desactivation"] end) - (Make_value(Cycle_repr)) + (Cycle_repr) module Delegated = Make_data_set_storage @@ -135,7 +135,7 @@ module Contract = struct module Counter = Indexed_context.Make_map (struct let name = ["counter"] end) - (Make_value(Int32)) + (Int32) module Code = Indexed_context.Make_carbonated_map @@ -169,22 +169,22 @@ module Contract = struct module Paid_storage_space_fees = Indexed_context.Make_map (struct let name = ["paid_bytes"] end) - (Make_value(Tez_repr)) + (Tez_repr) module Used_storage_space = Indexed_context.Make_map (struct let name = ["used_bytes"] end) - (Make_value(Int64)) + (Int64) module Roll_list = Indexed_context.Make_map (struct let name = ["roll_list"] end) - (Make_value(Roll_repr)) + (Roll_repr) module Change = Indexed_context.Make_map (struct let name = ["change"] end) - (Make_value(Tez_repr)) + (Tez_repr) end @@ -208,12 +208,12 @@ module Cycle = struct (Indexed_context.Raw_context) (struct let name = ["last_roll"] end)) (Int_index) - (Make_value(Roll_repr)) + (Roll_repr) module Roll_snapshot = Indexed_context.Make_map (struct let name = ["roll_snapshot"] end) - (Make_value(Int)) + (Int) type unrevealed_nonce = { nonce_hash: Nonce_hash.t ; @@ -255,18 +255,18 @@ module Cycle = struct (Indexed_context.Raw_context) (struct let name = ["nonces"] end)) (Raw_level_repr.Index) - (Make_value(struct - type t = nonce_status - let encoding = nonce_status_encoding - end)) + (struct + type t = nonce_status + let encoding = nonce_status_encoding + end) module Seed = Indexed_context.Make_map (struct let name = ["random_seed"] end) - (Make_value(struct - type t = Seed_repr.seed - let encoding = Seed_repr.seed_encoding - end)) + (struct + type t = Seed_repr.seed + let encoding = Seed_repr.seed_encoding + end) end @@ -284,13 +284,13 @@ module Roll = struct Make_single_data_storage (Raw_context) (struct let name = ["next"] end) - (Make_value(Roll_repr)) + (Roll_repr) module Limbo = Make_single_data_storage (Raw_context) (struct let name = ["limbo"] end) - (Make_value(Roll_repr)) + (Roll_repr) module Delegate_roll_list = Wrap_indexed_data_storage(Contract.Roll_list)(struct @@ -302,7 +302,7 @@ module Roll = struct module Successor = Indexed_context.Make_map (struct let name = ["successor"] end) - (Make_value(Roll_repr)) + (Roll_repr) module Delegate_change = Wrap_indexed_data_storage(Contract.Change)(struct @@ -333,7 +333,7 @@ module Roll = struct (Make_subcontext(Raw_context)(struct let name = ["owner"] end)) (Snapshoted_owner_index) (Roll_repr.Index) - (Make_value(Signature.Public_key)) + (Signature.Public_key) module Snapshot_for_cycle = Cycle.Roll_snapshot module Last_for_snapshot = Cycle.Last_roll @@ -353,34 +353,34 @@ module Vote = struct Make_single_data_storage (Raw_context) (struct let name = ["current_period_kind"] end) - (Make_value(struct - type t = Voting_period_repr.kind - let encoding = Voting_period_repr.kind_encoding - end)) + (struct + type t = Voting_period_repr.kind + let encoding = Voting_period_repr.kind_encoding + end) module Current_quorum = Make_single_data_storage (Raw_context) (struct let name = ["current_quorum"] end) - (Make_value(Int32)) + (Int32) module Current_proposal = Make_single_data_storage (Raw_context) (struct let name = ["current_proposal"] end) - (Make_value(Protocol_hash)) + (Protocol_hash) module Listings_size = Make_single_data_storage (Raw_context) (struct let name = ["listings_size"] end) - (Make_value(Int32)) + (Int32) module Listings = Make_indexed_data_storage (Make_subcontext(Raw_context)(struct let name = ["listings"] end)) (Signature.Public_key_hash) - (Make_value(Int32)) + (Int32) module Proposals = Make_data_set_storage @@ -391,10 +391,10 @@ module Vote = struct Make_indexed_data_storage (Make_subcontext(Raw_context)(struct let name = ["ballots"] end)) (Signature.Public_key_hash) - (Make_value(struct - type t = Vote_repr.ballot - let encoding = Vote_repr.ballot_encoding - end)) + (struct + type t = Vote_repr.ballot + let encoding = Vote_repr.ballot_encoding + end) end @@ -436,7 +436,7 @@ module Commitments = Make_indexed_data_storage (Make_subcontext(Raw_context)(struct let name = ["commitments"] end)) (Blinded_public_key_hash.Index) - (Make_value(Tez_repr)) + (Tez_repr) (** Ramp up security deposits... *) @@ -446,19 +446,19 @@ module Ramp_up = struct Make_indexed_data_storage (Make_subcontext(Raw_context)(struct let name = ["ramp_up"; "rewards"] end)) (Cycle_repr.Index) - (Make_value(struct - type t = Tez_repr.t * Tez_repr.t - let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding - end)) + (struct + type t = Tez_repr.t * Tez_repr.t + let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding + end) module Security_deposits = Make_indexed_data_storage (Make_subcontext(Raw_context)(struct let name = ["ramp_up"; "deposits"] end)) (Cycle_repr.Index) - (Make_value(struct - type t = Tez_repr.t * Tez_repr.t - let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding - end)) + (struct + type t = Tez_repr.t * Tez_repr.t + let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding + end) end diff --git a/src/proto_alpha/lib_protocol/src/storage_functors.ml b/src/proto_alpha/lib_protocol/src/storage_functors.ml index 2c2d76641..fea64e0e5 100644 --- a/src/proto_alpha/lib_protocol/src/storage_functors.ml +++ b/src/proto_alpha/lib_protocol/src/storage_functors.ml @@ -9,13 +9,7 @@ open Storage_sigs -module type ENCODED_VALUE = sig - type t - val encoding: t Data_encoding.t -end - -module Make_value (V : ENCODED_VALUE) = struct - type t = V.t +module Make_encoder (V : VALUE) = struct let of_bytes ~key b = match Data_encoding.Binary.of_bytes V.encoding b with | None -> Error [Raw_context.Storage_error (Corrupted_data key)] @@ -26,15 +20,8 @@ module Make_value (V : ENCODED_VALUE) = struct | None -> MBytes.create 0 end -module Make_carbonated_value (V : ENCODED_VALUE) = struct - type t = V.t - let of_bytes ~key b = - match Data_encoding.Binary.of_bytes V.encoding b with - | None -> Error [Raw_context.Storage_error (Corrupted_data key)] - | Some v -> Ok v - let to_bytes v = - try Data_encoding.Binary.to_bytes_exn V.encoding v - with _ -> MBytes.create 0 +module Make_carbonated_value (V : VALUE) = struct + include V let size = match Data_encoding.classify V.encoding with | `Fixed size -> Fixed size @@ -100,29 +87,30 @@ module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE) type value = V.t let mem t = C.mem t N.name + include Make_encoder(V) let get t = C.get t N.name >>=? fun b -> let key = C.absolute_key t N.name in - Lwt.return (V.of_bytes ~key b) + Lwt.return (of_bytes ~key b) let get_option t = C.get_option t N.name >>= function | None -> return None | Some b -> let key = C.absolute_key t N.name in - match V.of_bytes ~key b with + match of_bytes ~key b with | Ok v -> return (Some v) | Error _ as err -> Lwt.return err let init t v = - C.init t N.name (V.to_bytes v) >>=? fun t -> + C.init t N.name (to_bytes v) >>=? fun t -> return (C.project t) let set t v = - C.set t N.name (V.to_bytes v) >>=? fun t -> + C.set t N.name (to_bytes v) >>=? fun t -> return (C.project t) let init_set t v = - C.init_set t N.name (V.to_bytes v) >>= fun t -> + C.init_set t N.name (to_bytes v) >>= fun t -> Lwt.return (C.project t) let set_option t v = - C.set_option t N.name (Option.map ~f:V.to_bytes v) >>= fun t -> + C.set_option t N.name (Option.map ~f:to_bytes v) >>= fun t -> Lwt.return (C.project t) let remove t = C.remove t N.name >>= fun t -> @@ -141,6 +129,7 @@ module Make_single_carbonated_data_storage type value = V.t let consume_mem_gas c = Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)) + include Make_encoder(V) let existing_size c = match V.size with | Fixed len -> @@ -162,9 +151,9 @@ module Make_single_carbonated_data_storage match V.size with | Fixed s -> Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int s))) >>=? fun c -> - return (c, V.to_bytes v) + return (c, to_bytes v) | Variable -> - let bytes = V.to_bytes v in + let bytes = to_bytes v in let len = MBytes.length bytes in Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c -> set c (len_name N.name) (encode_len_value bytes) >>=? fun c -> @@ -182,7 +171,7 @@ module Make_single_carbonated_data_storage consume_read_gas C.get c >>=? fun c -> C.get c N.name >>=? fun bytes -> let key = C.absolute_key c N.name in - Lwt.return (V.of_bytes ~key bytes) >>=? fun res -> + Lwt.return (of_bytes ~key bytes) >>=? fun res -> return (C.project c, res) let get_option c = consume_mem_gas c >>=? fun c -> @@ -312,31 +301,32 @@ module Make_indexed_data_storage type context = t type key = I.t type value = V.t + include Make_encoder(V) let mem s i = C.mem s (I.to_path i []) let get s i = C.get s (I.to_path i []) >>=? fun b -> let key = C.absolute_key s (I.to_path i []) in - Lwt.return (V.of_bytes ~key b) + Lwt.return (of_bytes ~key b) let get_option s i = C.get_option s (I.to_path i []) >>= function | None -> return None | Some b -> let key = C.absolute_key s (I.to_path i []) in - match V.of_bytes ~key b with + match of_bytes ~key b with | Ok v -> return (Some v) | Error _ as err -> Lwt.return err let set s i v = - C.set s (I.to_path i []) (V.to_bytes v) >>=? fun t -> + C.set s (I.to_path i []) (to_bytes v) >>=? fun t -> return (C.project t) let init s i v = - C.init s (I.to_path i []) (V.to_bytes v) >>=? fun t -> + C.init s (I.to_path i []) (to_bytes v) >>=? fun t -> return (C.project t) let init_set s i v = - C.init_set s (I.to_path i []) (V.to_bytes v) >>= fun t -> + C.init_set s (I.to_path i []) (to_bytes v) >>= fun t -> Lwt.return (C.project t) let set_option s i v = - C.set_option s (I.to_path i []) (Option.map ~f:V.to_bytes v) >>= fun t -> + C.set_option s (I.to_path i []) (Option.map ~f:to_bytes v) >>= fun t -> Lwt.return (C.project t) let remove s i = C.remove s (I.to_path i []) >>= fun t -> @@ -392,6 +382,7 @@ module Make_indexed_carbonated_data_storage type context = t type key = I.t type value = V.t + include Make_encoder(V) let name i = I.to_path i [] let len_name i = @@ -423,9 +414,9 @@ module Make_indexed_carbonated_data_storage match V.size with | Fixed s -> Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int s))) >>=? fun c -> - return (c, V.to_bytes v) + return (c, to_bytes v) | Variable -> - let bytes = V.to_bytes v in + let bytes = to_bytes v in let len = MBytes.length bytes in Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c -> set c (len_name i) (encode_len_value bytes) >>=? fun c -> @@ -443,7 +434,7 @@ module Make_indexed_carbonated_data_storage consume_read_gas C.get s i >>=? fun s -> C.get s (name i) >>=? fun b -> let key = C.absolute_key s (name i) in - Lwt.return (V.of_bytes ~key b) >>=? fun v -> + Lwt.return (of_bytes ~key b) >>=? fun v -> return (C.project s, v) let get_option s i = consume_mem_gas s >>=? fun s -> @@ -537,7 +528,7 @@ module Make_indexed_carbonated_data_storage consume_read_gas C.get s path >>=? fun s -> C.get s (name path) >>=? fun b -> let key = C.absolute_key s (name path) in - Lwt.return (V.of_bytes ~key b) >>=? fun v -> + Lwt.return (of_bytes ~key b) >>=? fun v -> f path v (s, acc) in fold_keys_unaccounted s ~init ~f let bindings s = @@ -721,32 +712,33 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) type context = t type key = I.t type value = V.t + include Make_encoder(V) let mem s i = Raw_context.mem (s,i) N.name let get s i = Raw_context.get (s,i) N.name >>=? fun b -> let key = Raw_context.absolute_key (s,i) N.name in - Lwt.return (V.of_bytes ~key b) + Lwt.return (of_bytes ~key b) let get_option s i = Raw_context.get_option (s,i) N.name >>= function | None -> return None | Some b -> let key = Raw_context.absolute_key (s,i) N.name in - match V.of_bytes ~key b with + match of_bytes ~key b with | Ok v -> return (Some v) | Error _ as err -> Lwt.return err let set s i v = - Raw_context.set (s,i) N.name (V.to_bytes v) >>=? fun (s, _) -> + Raw_context.set (s,i) N.name (to_bytes v) >>=? fun (s, _) -> return (C.project s) let init s i v = - Raw_context.init (s,i) N.name (V.to_bytes v) >>=? fun (s, _) -> + Raw_context.init (s,i) N.name (to_bytes v) >>=? fun (s, _) -> return (C.project s) let init_set s i v = - Raw_context.init_set (s,i) N.name (V.to_bytes v) >>= fun (s, _) -> + Raw_context.init_set (s,i) N.name (to_bytes v) >>= fun (s, _) -> Lwt.return (C.project s) let set_option s i v = Raw_context.set_option (s,i) - N.name (Option.map ~f:V.to_bytes v) >>= fun (s, _) -> + N.name (Option.map ~f:to_bytes v) >>= fun (s, _) -> Lwt.return (C.project s) let remove s i = Raw_context.remove (s,i) N.name >>= fun (s, _) -> @@ -784,6 +776,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) type context = t type key = I.t type value = V.t + include Make_encoder(V) let consume_mem_gas c = Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)) let existing_size c = @@ -807,9 +800,9 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) match V.size with | Fixed s -> Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int s))) >>=? fun c -> - return (c, V.to_bytes v) + return (c, to_bytes v) | Variable -> - let bytes = V.to_bytes v in + let bytes = to_bytes v in let len = MBytes.length bytes in Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c -> set c (len_name N.name) (encode_len_value bytes) >>=? fun c -> @@ -827,7 +820,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) consume_read_gas Raw_context.get (s, i) >>=? fun c -> Raw_context.get c N.name >>=? fun b -> let key = Raw_context.absolute_key c N.name in - Lwt.return (V.of_bytes ~key b) >>=? fun v -> + Lwt.return (of_bytes ~key b) >>=? fun v -> return (Raw_context.project c, v) let get_option s i = consume_mem_gas (s, i) >>=? fun (s, _) -> @@ -894,7 +887,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) consume_read_gas Raw_context.get (s, i) >>=? fun (s, _) -> Raw_context.get (s, i) N.name >>=? fun b -> let key = Raw_context.absolute_key (s, i) N.name in - Lwt.return (V.of_bytes ~key b) >>=? fun v -> + Lwt.return (of_bytes ~key b) >>=? fun v -> f i v (s, acc)) >>=? fun (s, v) -> return (C.project s, v) let bindings s = diff --git a/src/proto_alpha/lib_protocol/src/storage_functors.mli b/src/proto_alpha/lib_protocol/src/storage_functors.mli index 3023fb7bd..c35c033a9 100644 --- a/src/proto_alpha/lib_protocol/src/storage_functors.mli +++ b/src/proto_alpha/lib_protocol/src/storage_functors.mli @@ -11,13 +11,6 @@ open Storage_sigs -module type ENCODED_VALUE = sig - type t - val encoding: t Data_encoding.t -end - -module Make_value (V : ENCODED_VALUE) : VALUE with type t = V.t - module Make_subcontext (C : Raw_context.T) (N : NAME) : Raw_context.T with type t = C.t @@ -26,7 +19,7 @@ module Make_single_data_storage : Single_data_storage with type t = C.t and type value = V.t -module Make_carbonated_value (V : ENCODED_VALUE) : CARBONATED_VALUE with type t = V.t +module Make_carbonated_value (V : VALUE) : CARBONATED_VALUE with type t = V.t module Make_single_carbonated_data_storage (C : Raw_context.T) (N : NAME) (V : CARBONATED_VALUE) diff --git a/src/proto_alpha/lib_protocol/src/storage_sigs.ml b/src/proto_alpha/lib_protocol/src/storage_sigs.ml index 7442e7fba..8ee5b5ab3 100644 --- a/src/proto_alpha/lib_protocol/src/storage_sigs.ml +++ b/src/proto_alpha/lib_protocol/src/storage_sigs.ml @@ -372,8 +372,7 @@ end module type VALUE = sig type t - val of_bytes: key:string list -> MBytes.t -> t tzresult - val to_bytes: t -> MBytes.t + val encoding: t Data_encoding.t end type value_size =