From ac62538eb6424266a3a91025ead152bf5c569b49 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Fri, 17 Nov 2017 15:42:13 +0100
Subject: [PATCH] Alpha: remove some fixme and assert false

---
 src/proto/alpha/raw_context.ml  | 27 +++++++++++++++++++++++----
 src/proto/alpha/storage.ml      | 12 ------------
 src/proto/alpha/storage.mli     |  2 +-
 src/proto/alpha/storage_sigs.ml | 23 +++++++++++++++++++----
 4 files changed, 43 insertions(+), 21 deletions(-)

diff --git a/src/proto/alpha/raw_context.ml b/src/proto/alpha/raw_context.ml
index 53e52a24f..6823c675a 100644
--- a/src/proto/alpha/raw_context.ml
+++ b/src/proto/alpha/raw_context.ml
@@ -221,6 +221,24 @@ let register_resolvers enc resolve =
 type error += Unimplemented_sandbox_migration
 
 let configure_sandbox ctxt json =
+  let rec json_equals x y = match x, y with
+    | `Float x, `Float y -> Compare.Float.(x = y)
+    | `Bool x, `Bool y -> Compare.Bool.(x = y)
+    | `String x, `String y -> Compare.String.(x = y)
+    | `Null, `Null -> true
+    | `O x, `O y ->
+        let sort =
+          List.sort (fun (a, _) (b, _) -> Compare.String.compare a b) in
+        Compare.Int.(=) (List.length x) (List.length y) &&
+        List.for_all2
+          (fun (nx, vx) (ny, vy) ->
+             Compare.String.(nx = ny) && json_equals vx vy)
+          (sort x) (sort y)
+    | `A x, `A y ->
+        Compare.Int.(=) (List.length x) (List.length y) &&
+        List.for_all2 json_equals x y
+    | _, _ -> false
+  in
   let json =
     match json with
     | None -> `O []
@@ -233,10 +251,11 @@ let configure_sandbox ctxt json =
       get_sandboxed ctxt >>=? function
       | None ->
           fail Unimplemented_sandbox_migration
-      | Some _ ->
-          (* FIXME GRGR fail if parameter changed! *)
-          (* failwith "Changing sandbox parameter is not yet implemented" *)
-          return ctxt
+      | Some existing ->
+          if json_equals existing json then
+            return ctxt
+          else
+            failwith "Changing sandbox parameter is not yet implemented"
 
 (* Generic context ********************************************************)
 
diff --git a/src/proto/alpha/storage.ml b/src/proto/alpha/storage.ml
index e2336a06d..a673b2b4a 100644
--- a/src/proto/alpha/storage.ml
+++ b/src/proto/alpha/storage.ml
@@ -33,11 +33,6 @@ module Contract = struct
       (struct let name = ["global_counter"] end)
       (Make_value(Int32))
 
-  (* module Set = *)
-  (* Make_data_set_storage *)
-  (* (Make_subcontext(Raw_context)(struct let name = ["set"] end)) *)
-  (* (Contract_repr.Index) *)
-
   module Indexed_context =
     Make_indexed_subcontext
       (Make_subcontext(Raw_context)(struct let name = ["index"] end))
@@ -330,13 +325,6 @@ module Seed = struct
     let set_option ctxt l v = Cycle.Nonce.set_option (ctxt, l.cycle) l.level v
     let delete ctxt l = Cycle.Nonce.delete (ctxt, l.cycle) l.level
     let remove ctxt l = Cycle.Nonce.remove (ctxt, l.cycle) l.level
-    (* We don't need the follwing iterators and I am kind of busy
-       defining a signature "Non_iterable_indexed_data_storage" *)
-    let clear _ctxt = assert false
-    let keys _ctxt = assert false
-    let bindings _ctxt = assert false
-    let fold _ctxt = assert false
-    let fold_keys _ctxt = assert false
   end
   module For_cycle = Cycle.Seed
 
diff --git a/src/proto/alpha/storage.mli b/src/proto/alpha/storage.mli
index 516f98a6a..99e377cc4 100644
--- a/src/proto/alpha/storage.mli
+++ b/src/proto/alpha/storage.mli
@@ -203,7 +203,7 @@ module Seed : sig
       }
     | Revealed of Seed_repr.nonce
 
-  module Nonce : Indexed_data_storage
+  module Nonce : Non_iterable_indexed_data_storage
     with type key := Level_repr.t
      and type value := nonce_status
      and type t := Raw_context.t
diff --git a/src/proto/alpha/storage_sigs.ml b/src/proto/alpha/storage_sigs.ml
index 7624760df..082474491 100644
--- a/src/proto/alpha/storage_sigs.ml
+++ b/src/proto/alpha/storage_sigs.ml
@@ -61,10 +61,8 @@ module type Single_data_storage = sig
 
 end
 
-(** The generic signature of indexed data accessors (a set of values
-    of the same type indexed by keys of the same form in the
-    hierarchical (key x value) database). *)
-module type Indexed_data_storage = sig
+(** Restricted version of {!Indexed_data_storage} w/o iterators. *)
+module type Non_iterable_indexed_data_storage = sig
 
   type t
   type context = t
@@ -115,13 +113,29 @@ module type Indexed_data_storage = sig
       bucket does not exists. *)
   val remove: context -> key -> Raw_context.t Lwt.t
 
+end
+
+(** The generic signature of indexed data accessors (a set of values
+    of the same type indexed by keys of the same form in the
+    hierarchical (key x value) database). *)
+module type Indexed_data_storage = sig
+
+  include Non_iterable_indexed_data_storage
+
+  (** Empties all the keys and associated data. *)
   val clear: context -> Raw_context.t Lwt.t
 
+  (** Lists all the keys. *)
   val keys: context -> key list Lwt.t
+
+  (** Lists all the keys and associated data. *)
   val bindings: context -> (key * value) list Lwt.t
 
+  (** Iterates over all the keys and associated data. *)
   val fold:
     context -> init:'a -> f:(key -> value -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+
+  (** Iterate over all the keys. *)
   val fold_keys:
     context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
 
@@ -151,6 +165,7 @@ module type Data_set_storage = sig
       particular order. *)
   val elements: context -> elt list Lwt.t
 
+  (** Iterates over the elements of the set. *)
   val fold: context -> init:'a -> f:(elt -> 'a -> 'a Lwt.t) -> 'a Lwt.t
 
   (** Removes all elements in the set *)