Alpha: minor signature change in storage functors

This commit is contained in:
Grégoire Henry 2018-04-23 00:08:57 +02:00 committed by Benjamin Canou
parent f7aa0398ca
commit 74acad1472
4 changed files with 89 additions and 104 deletions

View File

@ -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
(struct
type t = nonce_status
let encoding = nonce_status_encoding
end))
end)
module Seed =
Indexed_context.Make_map
(struct let name = ["random_seed"] end)
(Make_value(struct
(struct
type t = Seed_repr.seed
let encoding = Seed_repr.seed_encoding
end))
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
(struct
type t = Voting_period_repr.kind
let encoding = Voting_period_repr.kind_encoding
end))
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
(struct
type t = Vote_repr.ballot
let encoding = Vote_repr.ballot_encoding
end))
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
(struct
type t = Tez_repr.t * Tez_repr.t
let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
end))
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
(struct
type t = Tez_repr.t * Tez_repr.t
let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
end))
end)
end

View File

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

View File

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

View File

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