balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Alpha: better errors for corrupted context accesses

Browse Source
This commit is contained in:
Benjamin Canou 2018-04-13 19:59:39 +02:00 committed by Grégoire Henry
parent 6f3be375e8
commit bceb91289a
4 changed files with 46 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/proto_alpha/lib_protocol/src/raw_context.ml
View File

@ -381,6 +381,8 @@ module type T = sig
val project: context -> root_context
val absolute_key: context -> key -> key
val consume_gas: context -> Gas_repr.cost -> context tzresult
end
@ -454,3 +456,5 @@ let fold_keys ctxt k ~init ~f =
Context.fold_keys ctxt.context k ~init ~f
let project x = x
let absolute_key _ k = k

14
src/proto_alpha/lib_protocol/src/raw_context.mli
View File

@ -24,7 +24,9 @@ val storage_error: storage_error -> 'a tzresult Lwt.t
(** {1 Abstract Context} **************************************************)
(** Abstract view of the context *)
(** Abstract view of the context.
Includes a handle to the functional key-value database
({!Context.t}) along with some in-memory values (gas, etc.). *)
type t
type context = t
type root_context = t
@ -86,6 +88,9 @@ type key = string list
type value = MBytes.t
(** All context manipulation functions. This signature is included
as-is for direct context accesses, and used in {!Storage_functors}
to provide restricted views to the context. *)
module type T = sig
type t
@ -150,8 +155,15 @@ module type T = sig
val fold_keys:
context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
(** Internally used in {!Storage_functors} to escape from a view. *)
val project: context -> root_context
(** Internally used in {!Storage_functors} to retrieve a full key
from partial key relative a view. *)
val absolute_key: context -> key -> key
(** Internally used in {!Storage_functors} to consume gas from
within a view. *)
val consume_gas: context -> Gas_repr.cost -> context tzresult
end

43
src/proto_alpha/lib_protocol/src/storage_functors.ml
View File

@ -16,9 +16,9 @@ end
module Make_value (V : ENCODED_VALUE) = struct
type t = V.t
let of_bytes b =
let of_bytes ~key b =
match Data_encoding.Binary.of_bytes V.encoding b with
| None -> Error [Raw_context.Storage_error (Corrupted_data [(* FIXME??*)])]
| None -> Error [Raw_context.Storage_error (Corrupted_data key)]
| Some v -> Ok v
let to_bytes v =
match Data_encoding.Binary.to_bytes V.encoding v with
@ -28,9 +28,9 @@ end
module Make_carbonated_value (V : ENCODED_VALUE) = struct
type t = V.t
let of_bytes b =
let of_bytes ~key b =
match Data_encoding.Binary.of_bytes V.encoding b with
| None -> Error [Raw_context.Storage_error (Corrupted_data [(* FIXME??*)])]
| 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
@ -87,6 +87,7 @@ module Make_subcontext (C : Raw_context.T) (N : NAME)
let fold_keys t k ~init ~f =
C.fold_keys t (to_key k) ~init ~f:(fun k acc -> f (of_key k) acc)
let project = C.project
let absolute_key c k = C.absolute_key c (to_key k)
let consume_gas = C.consume_gas
end
@ -100,12 +101,14 @@ module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE)
C.mem t N.name
let get t =
C.get t N.name >>=? fun b ->
Lwt.return (V.of_bytes b)
let key = C.absolute_key t N.name in
Lwt.return (V.of_bytes ~key b)
let get_option t =
C.get_option t N.name >>= function
| None -> return None
| Some b ->
match V.of_bytes b with
let key = C.absolute_key t N.name in
match V.of_bytes ~key b with
| Ok v -> return (Some v)
| Error _ as err -> Lwt.return err
let init t v =
@ -177,7 +180,8 @@ module Make_single_carbonated_data_storage
let get c =
consume_read_gas C.get c >>=? fun c ->
C.get c N.name >>=? fun bytes ->
Lwt.return (V.of_bytes bytes) >>=? fun res ->
let key = C.absolute_key c N.name in
Lwt.return (V.of_bytes ~key bytes) >>=? fun res ->
return (C.project c, res)
let get_option c =
consume_mem_gas c >>=? fun c ->
@ -303,12 +307,14 @@ module Make_indexed_data_storage
C.mem s (I.to_path i [])
let get s i =
C.get s (I.to_path i []) >>=? fun b ->
Lwt.return (V.of_bytes b)
let key = C.absolute_key s (I.to_path i []) in
Lwt.return (V.of_bytes ~key b)
let get_option s i =
C.get_option s (I.to_path i []) >>= function
| None -> return None
| Some b ->
match V.of_bytes b with
let key = C.absolute_key s (I.to_path i []) in
match V.of_bytes ~key b with
| Ok v -> return (Some v)
| Error _ as err -> Lwt.return err
let set s i v =
@ -427,7 +433,8 @@ module Make_indexed_carbonated_data_storage
let get s i =
consume_read_gas C.get s i >>=? fun s ->
C.get s (name i) >>=? fun b ->
Lwt.return (V.of_bytes b) >>=? fun v ->
let key = C.absolute_key s (name i) in
Lwt.return (V.of_bytes ~key b) >>=? fun v ->
return (C.project s, v)
let get_option s i =
consume_mem_gas s >>=? fun s ->
@ -511,7 +518,8 @@ module Make_indexed_carbonated_data_storage
let f path (s, acc) =
consume_read_gas C.get s path >>=? fun s ->
C.get s (name path) >>=? fun b ->
Lwt.return (V.of_bytes b) >>=? fun v ->
let key = C.absolute_key s (name path) in
Lwt.return (V.of_bytes ~key b) >>=? fun v ->
f path v (s, acc) in
fold_keys_unaccounted s ~init ~f
let bindings s =
@ -600,6 +608,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
let fold_keys (t, i) k ~init ~f =
C.fold_keys t (to_key i k) ~init ~f:(fun k acc -> f (of_key k) acc)
let project (t, _) = C.project t
let absolute_key (t, i) k = C.absolute_key t (to_key i k)
let consume_gas (t, k) c = C.consume_gas t c >>? fun t -> ok (t, k)
end
@ -697,12 +706,14 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
Raw_context.mem (s,i) N.name
let get s i =
Raw_context.get (s,i) N.name >>=? fun b ->
Lwt.return (V.of_bytes b)
let key = Raw_context.absolute_key (s,i) N.name in
Lwt.return (V.of_bytes ~key b)
let get_option s i =
Raw_context.get_option (s,i) N.name >>= function
| None -> return None
| Some b ->
match V.of_bytes b with
let key = Raw_context.absolute_key (s,i) N.name in
match V.of_bytes ~key b with
| Ok v -> return (Some v)
| Error _ as err -> Lwt.return err
let set s i v =
@ -796,7 +807,8 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
let get s i =
consume_read_gas Raw_context.get (s, i) >>=? fun c ->
Raw_context.get c N.name >>=? fun b ->
Lwt.return (V.of_bytes b) >>=? fun v ->
let key = Raw_context.absolute_key c N.name in
Lwt.return (V.of_bytes ~key b) >>=? fun v ->
return (Raw_context.project c, v)
let get_option s i =
consume_mem_gas (s, i) >>=? fun (s, _) ->
@ -853,7 +865,8 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
Lwt.return acc >>=? fun (s, acc) ->
consume_read_gas Raw_context.get (s, i) >>=? fun (s, _) ->
Raw_context.get (s, i) N.name >>=? fun b ->
Lwt.return (V.of_bytes b) >>=? fun v ->
let key = Raw_context.absolute_key (s, i) N.name in
Lwt.return (V.of_bytes ~key b) >>=? fun v ->
f i v (s, acc)) >>=? fun (s, v) ->
return (C.project s, v)
let bindings s =

2
src/proto_alpha/lib_protocol/src/storage_sigs.ml
View File

@ -372,7 +372,7 @@ end
module type VALUE = sig
type t
val of_bytes: MBytes.t -> t tzresult
val of_bytes: key:string list -> MBytes.t -> t tzresult
val to_bytes: t -> MBytes.t
end