Alpha: minor signature change in storage functors

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
+      (struct
-         type t = nonce_status
+        type t = nonce_status
-         let encoding = nonce_status_encoding
+        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
+        type t = Seed_repr.seed
-         let encoding = Seed_repr.seed_encoding
+        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
+        type t = Voting_period_repr.kind
-         let encoding = Voting_period_repr.kind_encoding
+        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
+        type t = Vote_repr.ballot
-         let encoding = Vote_repr.ballot_encoding
+        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
+        type t = Tez_repr.t * Tez_repr.t
-         let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
+        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
+        type t = Tez_repr.t * Tez_repr.t
-         let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
+        let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
-       end))
+      end)
 
 end
 

src/proto_alpha/lib_protocol/src/storage_functors.ml

@@ -9,13 +9,7 @@
 
 open Storage_sigs
 
-module type ENCODED_VALUE = sig
+module Make_encoder (V : VALUE) = struct
-  type t
-  val encoding: t Data_encoding.t
-end
-
-module Make_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)]
@@ -26,15 +20,8 @@ module Make_value (V : ENCODED_VALUE) = struct
     | None -> MBytes.create 0
 end
 
-module Make_carbonated_value (V : ENCODED_VALUE) = struct
+module Make_carbonated_value (V : VALUE) = struct
-  type t = V.t
+  include V
-  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
   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 =

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)

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 encoding: t Data_encoding.t
-  val to_bytes: t -> MBytes.t
 end
 
 type value_size =