From c92f370930c5f1bf5224358f70d8cb3af6329cf5 Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.com>
Date: Thu, 22 Feb 2018 11:28:54 +0100
Subject: [PATCH] Add check of snapshot availability

---
 src/proto_alpha/lib_protocol/src/roll_storage.ml     | 3 +++
 src/proto_alpha/lib_protocol/src/storage_functors.ml | 3 +++
 src/proto_alpha/lib_protocol/src/storage_sigs.ml     | 1 +
 3 files changed, 7 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/src/roll_storage.ml b/src/proto_alpha/lib_protocol/src/roll_storage.ml
index a5d324d67..35ebbed05 100644
--- a/src/proto_alpha/lib_protocol/src/roll_storage.ml
+++ b/src/proto_alpha/lib_protocol/src/roll_storage.ml
@@ -11,6 +11,7 @@ type error +=
   | Consume_roll_change
   | No_roll_in_contract
   | Deleted_contract_owning_rolls
+  | No_roll_snapshot_for_cycle of Cycle_repr.t
 
 let get_contract_delegate c contract =
   match Contract_repr.is_default contract with
@@ -81,6 +82,8 @@ module Random = struct
           | Some delegate ->
               return delegate
     in
+    Storage.Roll.Owner.snapshot_exists c cycle >>= fun snapshot_exists ->
+    fail_unless snapshot_exists (No_roll_snapshot_for_cycle cycle) >>=? fun () ->
     loop sequence
 
 end
diff --git a/src/proto_alpha/lib_protocol/src/storage_functors.ml b/src/proto_alpha/lib_protocol/src/storage_functors.ml
index 5c2685bb1..ef818ca37 100644
--- a/src/proto_alpha/lib_protocol/src/storage_functors.ml
+++ b/src/proto_alpha/lib_protocol/src/storage_functors.ml
@@ -274,6 +274,9 @@ module Make_indexed_data_snapshotable_storage (C : Raw_context.T)
 
   let snapshot_path id = snapshot_name @ Snapshot_index.to_path id []
 
+  let snapshot_exists s id =
+    C.dir_mem s (snapshot_path id)
+
   let snapshot s id =
     C.copy s ~from:data_name ~to_:(snapshot_path id) >>=? fun t ->
     return (C.project t)
diff --git a/src/proto_alpha/lib_protocol/src/storage_sigs.ml b/src/proto_alpha/lib_protocol/src/storage_sigs.ml
index 07e4ddaed..d59dfac20 100644
--- a/src/proto_alpha/lib_protocol/src/storage_sigs.ml
+++ b/src/proto_alpha/lib_protocol/src/storage_sigs.ml
@@ -152,6 +152,7 @@ module type Indexed_data_snapshotable_storage = sig
      and type value = value
      and type t = t
 
+  val snapshot_exists : context -> snapshot -> bool Lwt.t
   val snapshot : context -> snapshot -> Raw_context.t tzresult Lwt.t
   val delete_snapshot : context -> snapshot -> Raw_context.t Lwt.t