From 1a94bfd0e91a98a55acfa14879d14552af4731cf Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.com>
Date: Tue, 20 Feb 2018 19:12:02 +0100
Subject: [PATCH] Add copy to the storage

---
 src/lib_protocol_environment/sigs/v1/context.mli           | 3 +++
 src/lib_protocol_environment/tezos_protocol_environment.ml | 1 +
 .../tezos_protocol_environment.mli                         | 1 +
 .../tezos_protocol_environment_faked.ml                    | 1 +
 .../tezos_protocol_environment_memory.ml                   | 4 ++++
 src/lib_storage/context.ml                                 | 7 +++++++
 src/lib_storage/context.mli                                | 3 +++
 7 files changed, 20 insertions(+)

diff --git a/src/lib_protocol_environment/sigs/v1/context.mli b/src/lib_protocol_environment/sigs/v1/context.mli
index 78322931d..b06089f73 100644
--- a/src/lib_protocol_environment/sigs/v1/context.mli
+++ b/src/lib_protocol_environment/sigs/v1/context.mli
@@ -25,6 +25,9 @@ val get: t -> key -> value option Lwt.t
 
 val set: t -> key -> value -> t Lwt.t
 
+(** [copy] returns None if the [from] key is not bound *)
+val copy: t -> from:key -> to_:key -> t option Lwt.t
+
 val del: t -> key -> t Lwt.t
 val remove_rec: t -> key -> t Lwt.t
 
diff --git a/src/lib_protocol_environment/tezos_protocol_environment.ml b/src/lib_protocol_environment/tezos_protocol_environment.ml
index 0c3c63e79..837f1b20f 100644
--- a/src/lib_protocol_environment/tezos_protocol_environment.ml
+++ b/src/lib_protocol_environment/tezos_protocol_environment.ml
@@ -17,6 +17,7 @@ module type CONTEXT = sig
   val dir_mem: t -> key -> bool Lwt.t
   val get: t -> key -> value option Lwt.t
   val set: t -> key -> value -> t Lwt.t
+  val copy: t -> from:key -> to_:key -> t option Lwt.t
   val del: t -> key -> t Lwt.t
   val remove_rec: t -> key -> t Lwt.t
   val fold:
diff --git a/src/lib_protocol_environment/tezos_protocol_environment.mli b/src/lib_protocol_environment/tezos_protocol_environment.mli
index 39a7e5ef4..3289fbdac 100644
--- a/src/lib_protocol_environment/tezos_protocol_environment.mli
+++ b/src/lib_protocol_environment/tezos_protocol_environment.mli
@@ -10,6 +10,7 @@ module type CONTEXT = sig
   val dir_mem: t -> key -> bool Lwt.t
   val get: t -> key -> value option Lwt.t
   val set: t -> key -> value -> t Lwt.t
+  val copy: t -> from:key -> to_:key -> t option Lwt.t
   val del: t -> key -> t Lwt.t
   val remove_rec: t -> key -> t Lwt.t
   val fold:
diff --git a/src/lib_protocol_environment/tezos_protocol_environment_faked.ml b/src/lib_protocol_environment/tezos_protocol_environment_faked.ml
index 18ed49f63..ce5997d7c 100644
--- a/src/lib_protocol_environment/tezos_protocol_environment_faked.ml
+++ b/src/lib_protocol_environment/tezos_protocol_environment_faked.ml
@@ -16,6 +16,7 @@ module Context = struct
   let dir_mem _ _ = assert false
   let get _ _ = assert false
   let set _ _ _ = assert false
+  let copy _ ~from:_ ~to_:_ = assert false
   let del _ _ = assert false
   let remove_rec _ _ = assert false
   let fold _ _ ~init:_ ~f:_ = assert false
diff --git a/src/lib_protocol_environment/tezos_protocol_environment_memory.ml b/src/lib_protocol_environment/tezos_protocol_environment_memory.ml
index e5672a3a1..57c74b46b 100644
--- a/src/lib_protocol_environment/tezos_protocol_environment_memory.ml
+++ b/src/lib_protocol_environment/tezos_protocol_environment_memory.ml
@@ -86,6 +86,10 @@ module Context = struct
     match raw_set m k None with
     | None -> Lwt.return m
     | Some m -> Lwt.return m
+  let copy m ~from ~to_ =
+    match raw_get m from with
+    | None -> Lwt.return_none
+    | Some v -> Lwt.return (raw_set m to_ (Some v))
 
   let fold m k ~init ~f =
     match raw_get m k with
diff --git a/src/lib_storage/context.ml b/src/lib_storage/context.ml
index 820ccc1a9..1155ce7ff 100644
--- a/src/lib_storage/context.ml
+++ b/src/lib_storage/context.ml
@@ -157,6 +157,13 @@ let remove_rec ctxt key =
   GitStore.Tree.remove ctxt.tree (data_key key) >>= fun tree ->
   Lwt.return { ctxt with tree }
 
+let copy ctxt ~from ~to_ =
+  GitStore.Tree.find_tree ctxt.tree (data_key from) >>= function
+  | None -> Lwt.return_none
+  | Some sub_tree ->
+      GitStore.Tree.add_tree ctxt.tree (data_key to_) sub_tree >>= fun tree ->
+      Lwt.return_some { ctxt with tree }
+
 let fold ctxt key ~init ~f =
   GitStore.Tree.list ctxt.tree (data_key key) >>= fun keys ->
   Lwt_list.fold_left_s
diff --git a/src/lib_storage/context.mli b/src/lib_storage/context.mli
index 9a24996bb..2cad47acb 100644
--- a/src/lib_storage/context.mli
+++ b/src/lib_storage/context.mli
@@ -45,6 +45,9 @@ val set: context -> key -> value -> t Lwt.t
 val del: context -> key -> t Lwt.t
 val remove_rec: context -> key -> t Lwt.t
 
+(** [copy] returns None if the [from] key is not bound *)
+val copy: context -> from:key -> to_:key -> context option Lwt.t
+
 val fold:
   context -> key -> init:'a ->
   f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) ->