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

Snapshotable storage

Browse Source
This commit is contained in:
Pierre Chambart 2018-02-22 01:29:23 +01:00 committed by Grégoire Henry
parent 3caa5c2260
commit 3b4490129b
3 changed files with 54 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -254,6 +254,37 @@ module Make_indexed_data_storage
end
module Make_indexed_data_snapshotable_storage (C : Raw_context.T)
(Snapshot_index : INDEX) (I : INDEX) (V : VALUE)
: Indexed_data_snapshotable_storage with type t = C.t
and type snapshot = Snapshot_index.t
and type key = I.t
and type value = V.t = struct
type snapshot = Snapshot_index.t
let data_name = ["current"]
let snapshot_name = ["snapshot"]
let snapshot_name_length = List.length snapshot_name
module C_data = Make_subcontext(C)(struct let name = data_name end)
module C_snapshot = Make_subcontext(C)(struct let name = snapshot_name end)
include Make_indexed_data_storage(C_data)(I) (V)
module Snapshot = Make_indexed_data_storage(C_snapshot)(Pair(Snapshot_index)(I))(V)
let snapshot_path id = snapshot_name @ Snapshot_index.to_path id []
let snapshot s id =
C.copy s ~from:data_name ~to_:(snapshot_path id) >>=? fun t ->
return (C.project t)
let delete_snapshot s id =
C.remove_rec s (Snapshot_index.to_path id snapshot_name) >>= fun t ->
Lwt.return (C.project t)
end
module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
: Indexed_raw_context with type t = C.t
and type key = I.t = struct

7
src/proto_alpha/lib_protocol/src/storage_functors.mli
View File

@ -44,6 +44,13 @@ module Make_indexed_data_storage (C : Raw_context.T) (I : INDEX) (V : VALUE)
and type key = I.t
and type value = V.t
module Make_indexed_data_snapshotable_storage (C : Raw_context.T)
(Snapshot : INDEX) (I : INDEX) (V : VALUE)
: Indexed_data_snapshotable_storage with type t = C.t
and type snapshot = Snapshot.t
and type key = I.t
and type value = V.t
module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
: Indexed_raw_context with type t = C.t
and type key = I.t

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

@ -141,6 +141,22 @@ module type Indexed_data_storage = sig
end
module type Indexed_data_snapshotable_storage = sig
type snapshot
type key
include Indexed_data_storage with type key := key
module Snapshot : Indexed_data_storage
with type key = (snapshot * key)
and type value = value
and type t = t
val snapshot : context -> snapshot -> Raw_context.t tzresult Lwt.t
val delete_snapshot : context -> snapshot -> Raw_context.t Lwt.t
end
(** The generic signature of a data set accessor (a set of values
bound to a specific key prefix in the hierarchical (key x value)
database). *)