From 015f3edff32fae9bdd9587ce3c866919d502fb6d Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Fri, 3 Mar 2017 13:05:20 +0100
Subject: [PATCH] Shell-level commit messages and timestamps.

---
 src/node/db/context.ml                   | 96 +++++++++++++-----------
 src/node/db/context.mli                  | 10 ++-
 src/node/shell/prevalidator.ml           | 16 ++--
 src/node/shell/state.ml                  |  2 +-
 src/node/shell/validator.ml              |  6 +-
 src/node/updater/protocol.mli            | 14 ++--
 src/node/updater/register.ml             |  6 +-
 src/proto/alpha/apply.ml                 | 23 +++---
 src/proto/alpha/init_storage.ml          |  2 -
 src/proto/alpha/main.ml                  | 11 ++-
 src/proto/alpha/mining.ml                | 32 ++++++--
 src/proto/alpha/mining.mli               |  6 +-
 src/proto/alpha/reward_storage.ml        |  2 +-
 src/proto/alpha/script_interpreter.ml    |  2 +-
 src/proto/alpha/services_registration.ml | 14 +++-
 src/proto/alpha/storage.ml               | 16 +---
 src/proto/alpha/storage.mli              | 12 +--
 src/proto/alpha/tezos_context.ml         | 15 +++-
 src/proto/alpha/tezos_context.mli        |  5 +-
 src/proto/demo/main.ml                   |  8 +-
 src/proto/environment/context.mli        |  4 +-
 src/proto/environment/updater.mli        | 14 ++--
 src/proto/genesis/main.ml                | 10 ++-
 test/test_context.ml                     | 17 +----
 test/test_state.ml                       |  2 +-
 25 files changed, 189 insertions(+), 156 deletions(-)

diff --git a/src/node/db/context.ml b/src/node/db/context.ml
index 8f2ca7415..c3516ea81 100644
--- a/src/node/db/context.ml
+++ b/src/node/db/context.ml
@@ -58,21 +58,21 @@ type t = context
 
 (*-- Version Access and Update -----------------------------------------------*)
 
-let genesis_block_key = ["genesis";"block"]
-let genesis_protocol_key = ["genesis";"protocol"]
-let genesis_time_key = ["genesis";"time"]
 let current_protocol_key = ["protocol"]
 let current_fitness_key = ["fitness"]
+let current_timestamp_key = ["timestamp"]
 let current_test_protocol_key = ["test_protocol"]
 let current_test_network_key = ["test_network"]
 let current_test_network_expiration_key = ["test_network_expiration"]
 let current_fork_test_network_key = ["fork_test_network"]
 
+let transient_commit_message_key = ["message"]
+
 let exists { repo } key =
   GitStore.of_branch_id
     Irmin.Task.none (Block_hash.to_b58check key) repo >>= fun t ->
   let store = t () in
-  GitStore.read store genesis_block_key >>= function
+  GitStore.read store current_protocol_key >>= function
   | Some _ ->
       Lwt.return true
   | None ->
@@ -108,22 +108,58 @@ let exists index key =
     Block_hash.pp_short key exists >>= fun () ->
   Lwt.return exists
 
+let get_and_erase_commit_message ctxt =
+  GitStore.FunView.get ctxt.view transient_commit_message_key >>= function
+  | None -> Lwt.return (None, ctxt)
+  | Some bytes ->
+     GitStore.FunView.del ctxt.view transient_commit_message_key >>= fun view ->
+     Lwt.return (Some (MBytes.to_string bytes), { ctxt with view })
+let set_commit_message ctxt msg =
+  GitStore.FunView.set ctxt.view
+    transient_commit_message_key
+    (MBytes.of_string msg) >>= fun view ->
+  Lwt.return { ctxt with view }
+
+let get_fitness { view } =
+  GitStore.FunView.get view current_fitness_key >>= function
+  | None -> assert false
+  | Some data ->
+      match Data_encoding.Binary.of_bytes Fitness.encoding data with
+      | None -> assert false
+      | Some data -> Lwt.return data
+let set_fitness ctxt data =
+  GitStore.FunView.set ctxt.view current_fitness_key
+    (Data_encoding.Binary.to_bytes Fitness.encoding data) >>= fun view ->
+  Lwt.return { ctxt with view }
+
+let get_timestamp { view } =
+  GitStore.FunView.get view current_timestamp_key >>= function
+  | None -> assert false
+  | Some time ->
+     Lwt.return (Time.of_notation_exn (MBytes.to_string time))
+let set_timestamp ctxt time =
+  GitStore.FunView.set ctxt.view current_timestamp_key
+    (MBytes.of_string (Time.to_notation time)) >>= fun view ->
+  Lwt.return { ctxt with view }
+
 exception Preexistent_context of Block_hash.t
 exception Empty_head of Block_hash.t
 
-let commit block key context =
+let commit key context =
+  get_timestamp context >>= fun timestamp ->
+  get_fitness context >>= fun fitness ->
   let task =
-    Irmin.Task.create
-      ~date:(Time.to_seconds block.Store.Block_header.shell.timestamp)
-      ~owner:"tezos" in
+    Irmin.Task.create ~date:(Time.to_seconds timestamp) ~owner:"Tezos" in
   GitStore.clone task context.store (Block_hash.to_b58check key) >>= function
   | `Empty_head -> Lwt.fail (Empty_head key)
   | `Duplicated_branch -> Lwt.fail (Preexistent_context key)
   | `Ok store ->
-      let msg =
-        Format.asprintf "%a %a"
-          Fitness.pp block.shell.fitness
-          Block_hash.pp_short key in
+     get_and_erase_commit_message context >>= fun (msg, context) ->
+     let msg = match msg with
+       | None ->
+          Format.asprintf "%a %a"
+            Fitness.pp fitness Block_hash.pp_short key
+       | Some msg -> msg in
       GitStore.FunView.update_path (store msg) [] context.view
 
 
@@ -144,10 +180,7 @@ let dir_mem ctxt key =
   GitStore.FunView.dir_mem ctxt.view (data_key key) >>= fun v ->
   Lwt.return v
 
-let raw_get ctxt key =
-  GitStore.FunView.get ctxt.view key >>= function
-  | None -> Lwt.return_none
-  | Some bytes -> Lwt.return (Some bytes)
+let raw_get ctxt key = GitStore.FunView.get ctxt.view key
 let get t key = raw_get t (data_key key)
 
 let raw_set ctxt key data =
@@ -188,11 +221,7 @@ let commit_genesis index ~id:block ~time ~protocol ~test_protocol =
     index.repo >>= fun t ->
   let store = t () in
   GitStore.FunView.of_path store [] >>= fun view ->
-  GitStore.FunView.set view genesis_block_key
-    (Block_hash.to_bytes block) >>= fun view ->
-  GitStore.FunView.set view genesis_protocol_key
-    (Protocol_hash.to_bytes protocol) >>= fun view ->
-  GitStore.FunView.set view genesis_time_key
+  GitStore.FunView.set view current_timestamp_key
     (MBytes.of_string (Time.to_notation time)) >>= fun view ->
   GitStore.FunView.set view current_protocol_key
     (Protocol_hash.to_bytes protocol) >>= fun view ->
@@ -214,17 +243,6 @@ let get_protocol v =
 let set_protocol v key =
   raw_set v current_protocol_key (Protocol_hash.to_bytes key)
 
-let get_fitness v =
-  raw_get v current_fitness_key >>= function
-  | None -> assert false
-  | Some data ->
-      match Data_encoding.Binary.of_bytes Fitness.encoding data with
-      | None -> assert false
-      | Some data -> Lwt.return data
-let set_fitness v data =
-  raw_set v current_fitness_key
-    (Data_encoding.Binary.to_bytes Fitness.encoding data)
-
 let get_test_protocol v =
   raw_get v current_test_protocol_key >>= function
   | None -> assert false
@@ -260,23 +278,11 @@ let read_and_reset_fork_test_network v =
 let fork_test_network v =
   raw_set v current_fork_test_network_key (MBytes.of_string "fork")
 
-let get_genesis_block v =
-  raw_get v genesis_block_key >>= function
-  | None -> assert false
-  | Some block -> Lwt.return (Block_hash.of_bytes_exn block)
-
-let get_genesis_time v =
-  raw_get v genesis_time_key >>= function
-  | None -> assert false
-  | Some time -> Lwt.return (Time.of_notation_exn (MBytes.to_string time))
-
 let init_test_network v ~time ~genesis =
   get_test_protocol v >>= fun test_protocol ->
   del_test_network_expiration v >>= fun v ->
   set_protocol v test_protocol >>= fun v ->
-  raw_set v genesis_time_key
-    (MBytes.of_string (Time.to_notation time)) >>= fun v ->
-  raw_set v genesis_block_key (Block_hash.to_bytes genesis) >>= fun v ->
+  set_timestamp v time >>= fun v ->
   let task =
     Irmin.Task.create
       ~date:(Time.to_seconds time)
diff --git a/src/node/db/context.mli b/src/node/db/context.mli
index 35a60f207..150c8eda1 100644
--- a/src/node/db/context.mli
+++ b/src/node/db/context.mli
@@ -40,7 +40,7 @@ exception Preexistent_context of Block_hash.t
 val exists: index -> Block_hash.t -> bool Lwt.t
 val checkout: index -> Block_hash.t -> context option Lwt.t
 val checkout_exn: index -> Block_hash.t -> context Lwt.t
-val commit: Store.Block_header.t -> Block_hash.t -> context -> unit Lwt.t
+val commit: Block_hash.t -> context -> unit Lwt.t
 
 (** {2 Predefined Fields} ****************************************************)
 
@@ -61,11 +61,13 @@ val del_test_network_expiration: context -> context Lwt.t
 val read_and_reset_fork_test_network: context -> (bool * context) Lwt.t
 val fork_test_network: context -> context Lwt.t
 
-val get_genesis_time: context -> Time.t Lwt.t
-val get_genesis_block: context -> Block_hash.t Lwt.t
-
 val set_fitness: context -> Fitness.fitness -> context Lwt.t
 val get_fitness: context -> Fitness.fitness Lwt.t
 
+val set_timestamp: context -> Time.t -> context Lwt.t
+val get_timestamp: context -> Time.t Lwt.t
+
+val set_commit_message: context -> string -> context Lwt.t
+
 val init_test_network:
   context ->  time:Time.t -> genesis:Block_hash.t -> context tzresult Lwt.t
diff --git a/src/node/shell/prevalidator.ml b/src/node/shell/prevalidator.ml
index cf30a9126..d369b490f 100644
--- a/src/node/shell/prevalidator.ml
+++ b/src/node/shell/prevalidator.ml
@@ -28,7 +28,8 @@ let preapply
                Lwt.return_none
            | Ok p -> Lwt.return (Some p))
     ops >>= fun ops ->
-  Proto.preapply ctxt block timestamp sort (Utils.unopt_list ops) >>= function
+  Context.set_timestamp ctxt timestamp >>= fun ctxt ->
+  Proto.preapply ctxt block sort (Utils.unopt_list ops) >>= function
   | Ok (ctxt, r)  ->
       lwt_debug "<- prevalidate (%d/%d/%d/%d)"
         (List.length r.Updater.applied)
@@ -105,7 +106,8 @@ let create net_db =
   let timestamp = ref (Time.now ()) in
   begin
     let (module Proto) = protocol in
-    Proto.preapply head.context head.hash !timestamp false [] >|= function
+    Context.set_timestamp head.context !timestamp >>= fun ctxt ->
+    Proto.preapply ctxt head.hash false [] >|= function
     | Error _ -> ref head.context
     | Ok (ctxt, _) -> ref ctxt
   end >>= fun context ->
@@ -214,9 +216,9 @@ let create net_db =
                               (Proto.parse_operation h b
                                |> record_trace_exn (Invalid_operation h)))
                       (Operation_hash.Map.bindings ops) >>=? fun parsed_ops ->
+                    Context.set_timestamp !context (Time.now ()) >>= fun ctxt ->
                     Proto.preapply
-                      !context !head.hash (Time.now ())
-                      true parsed_ops >>=? fun (ctxt, res) ->
+                      ctxt !head.hash true parsed_ops >>=? fun (ctxt, res) ->
                     let register h =
                       let op = Operation_hash.Map.find h ops in
                       Distributed_db.Operation.inject
@@ -287,8 +289,10 @@ let create net_db =
                   timestamp := Time.now () ;
                   (* Tag the context as a prevalidation context. *)
                   let (module Proto) = new_protocol in
-                  Proto.preapply new_head.context
-                    new_head.hash !timestamp false [] >>= function
+                  Context.set_timestamp
+                    new_head.context !timestamp >>= fun ctxt ->
+                  Proto.preapply
+                    ctxt new_head.hash false [] >>= function
                   | Error _ -> set_context new_head.context
                   | Ok (ctxt, _) -> set_context ctxt)
             q >>= fun () ->
diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml
index 0ff3ffc6f..cfe4178f7 100644
--- a/src/node/shell/state.ml
+++ b/src/node/shell/state.ml
@@ -864,7 +864,7 @@ module Valid_block = struct
         block_header_store hash >>= fun _marked ->
       (* TODO fail if the block was previsouly stored ... ??? *)
       (* Let's commit the context. *)
-      Context.commit block hash context >>= fun () ->
+      Context.commit hash context >>= fun () ->
       (* Update the chain state. *)
       let store = net_state.chain_store in
       let predecessor = block.shell.predecessor in
diff --git a/src/node/shell/validator.ml b/src/node/shell/validator.ml
index 3dde9c655..1e8893ff5 100644
--- a/src/node/shell/validator.ml
+++ b/src/node/shell/validator.ml
@@ -143,14 +143,16 @@ let apply_block net db
   begin
     match pred.protocol with
     | None -> fail (State.Unknown_protocol pred.protocol_hash)
-    | Some p -> return (p, pred.context)
+    | Some p ->
+       Context.set_timestamp pred.context block.shell.timestamp >>= fun c ->
+       return (p, c)
   end >>=? fun ((module Proto), patched_context) ->
   lwt_debug "validation of %a: Proto %a"
     Block_hash.pp_short hash
     Protocol_hash.pp_short Proto.hash >>= fun () ->
   lwt_debug "validation of %a: parsing header..."
     Block_hash.pp_short hash >>= fun () ->
-  Lwt.return (Proto.parse_block block) >>=? fun parsed_header ->
+  Lwt.return (Proto.parse_block block pred.timestamp) >>=? fun parsed_header ->
   lwt_debug "validation of %a: parsing operations..."
     Block_hash.pp_short hash >>= fun () ->
   map2_s
diff --git a/src/node/updater/protocol.mli b/src/node/updater/protocol.mli
index 1cf819452..903465cd5 100644
--- a/src/node/updater/protocol.mli
+++ b/src/node/updater/protocol.mli
@@ -89,8 +89,9 @@ module type PROTOCOL = sig
       produce a pre-decomposed value of the high level, protocol defined
       {!block} type. It does not have access to the storage
       context. It may store the hash and raw bytes for later signature
-      verification by {!apply} or {!preapply}. *)
-  val parse_block : raw_block -> block tzresult
+      verification by {!apply} or {!preapply}. The timestamp of the
+      predecessor block is also provided for early delay checks. *)
+  val parse_block : raw_block -> Time.t -> block tzresult
 
   (** The parsing / preliminary validation function for
       operations. Similar to {!parse_block}. *)
@@ -107,14 +108,13 @@ module type PROTOCOL = sig
   (** The auxiliary protocol entry point that validates pending
       operations out of blocks. This function tries to apply the all
       operations in the given order, and returns which applications have
-      suceeded and which ones have failed. The first three parameters
-      are a context in which to apply the operations, the hash of the
-      preceding block and the date at which the operations are
-      executed. This function is used by the shell for accepting or
+      suceeded and which ones have failed. The first two parameters
+      are a context in which to apply the operations and the hash of the
+      preceding block. This function is used by the shell for accepting or
       dropping operations, as well as the mining client to check that a
       sequence of operations forms a valid block. *)
   val preapply :
-    Context.t -> Block_hash.t -> Time.t -> bool -> operation list ->
+    Context.t -> Block_hash.t -> bool -> operation list ->
     (Context.t * error preapply_result) tzresult Lwt.t
 
   (** The list of remote procedures exported by this implementation *)
diff --git a/src/node/updater/register.ml b/src/node/updater/register.ml
index dc13192be..bf90322c9 100644
--- a/src/node/updater/register.ml
+++ b/src/node/updater/register.ml
@@ -33,11 +33,11 @@ let register (module Proto : Protocol.PACKED_PROTOCOL) =
   let module V = struct
     include Proto
     include Make(Proto)
-    let parse_block d = parse_block d |> wrap_error
+    let parse_block d t = parse_block d t |> wrap_error
     let parse_operation h b = parse_operation h b |> wrap_error
     let apply c h ops = apply c h ops >|= wrap_error
-    let preapply c h t b ops =
-      (preapply c h t b ops >|= wrap_error) >>=? fun (ctxt, r) ->
+    let preapply c h b ops =
+      (preapply c h b ops >|= wrap_error) >>=? fun (ctxt, r) ->
       return (ctxt, Updater.map_result (fun l -> [Ecoproto_error l]) r)
     let configure_sandbox c j =
       configure_sandbox c j >|= wrap_error
diff --git a/src/proto/alpha/apply.ml b/src/proto/alpha/apply.ml
index 922f4075d..c761d2ffa 100644
--- a/src/proto/alpha/apply.ml
+++ b/src/proto/alpha/apply.ml
@@ -213,23 +213,21 @@ let may_start_new_cycle ctxt =
       Seed.compute_for_cycle ctxt (Cycle.succ new_cycle) >>=? fun ctxt ->
       Roll.clear_cycle ctxt last_cycle >>=? fun ctxt ->
       Roll.freeze_rolls_for_cycle ctxt (Cycle.succ new_cycle) >>=? fun ctxt ->
-      Timestamp.get_current ctxt >>=? fun timestamp ->
+      Timestamp.get_current ctxt >>= fun timestamp ->
       Lwt.return (Timestamp.(timestamp +? (Constants.time_before_reward ctxt)))
       >>=? fun reward_date ->
       Reward.set_reward_time_for_cycle
         ctxt last_cycle reward_date >>=? fun ctxt ->
       return ctxt
 
-let apply_main ctxt accept_failing_script block operations =
+let apply_main ctxt accept_failing_script block pred_timestamp operations =
   (* read only checks *)
   Mining.check_proof_of_work_stamp ctxt block >>=? fun () ->
   Mining.check_fitness_gap ctxt block >>=? fun () ->
-  Mining.check_mining_rights ctxt block >>=? fun delegate_pkh ->
+  Mining.check_mining_rights ctxt block pred_timestamp >>=? fun delegate_pkh ->
   Mining.check_signature ctxt block delegate_pkh >>=? fun () ->
   (* automatic bonds payment *)
   Mining.pay_mining_bond ctxt block delegate_pkh >>=? fun ctxt ->
-  (* set timestamp *)
-  Timestamp.set_current ctxt block.shell.timestamp >>=? fun ctxt ->
   (* do effectful stuff *)
   Fitness.increase ctxt >>=? fun ctxt ->
   let priority = snd block.proto.mining_slot in
@@ -255,14 +253,20 @@ let apply_main ctxt accept_failing_script block operations =
 
 type error += Internal_error of string
 
-let apply ctxt accept_failing_script block operations =
+let apply ctxt accept_failing_script block pred_timestamp operations =
   (init ctxt >>=? fun ctxt ->
    get_prevalidation ctxt >>= function
    | true ->
        fail (Internal_error "we should not call `apply` after `preapply`!")
    | false ->
-       apply_main ctxt accept_failing_script block operations >>=? fun ctxt ->
-       finalize ctxt)
+      apply_main ctxt accept_failing_script block pred_timestamp operations >>=? fun ctxt ->
+      Level.current ctxt >>=? fun { level } ->
+      let level = Raw_level.diff level Raw_level.root in
+      Fitness.get ctxt >>=? fun fitness ->
+      let commit_message =
+        (* TODO: add more info ? *)
+        Format.asprintf "lvl %ld, fit %Ld" level fitness in
+      finalize ~commit_message ctxt)
 
 let empty_result =
   { Updater.applied = [];
@@ -338,7 +342,7 @@ let prevalidate ctxt pred_block sort operations =
          return (ctxt, r)) in
   loop ctxt operations
 
-let preapply ctxt pred_block timestamp sort operations =
+let preapply ctxt pred_block sort operations =
   let result =
     init ctxt >>=? fun ctxt ->
     begin
@@ -349,7 +353,6 @@ let preapply ctxt pred_block timestamp sort operations =
           Fitness.increase ctxt >>=? fun ctxt ->
           return ctxt
     end >>=? fun ctxt ->
-    Timestamp.set_current ctxt timestamp >>=? fun ctxt ->
     prevalidate ctxt pred_block sort operations >>=? fun (ctxt, r) ->
     (* TODO should accept failing script in the last round ?
             or: what should we export to let the miner decide *)
diff --git a/src/proto/alpha/init_storage.ml b/src/proto/alpha/init_storage.ml
index d97d14140..a51f2ed04 100644
--- a/src/proto/alpha/init_storage.ml
+++ b/src/proto/alpha/init_storage.ml
@@ -17,8 +17,6 @@ let version_value = "alpha"
 let initialize ~from_genesis (ctxt:Context.t) =
   Context.set ctxt version_key (MBytes.of_string version_value) >>= fun ctxt ->
   Storage.prepare ctxt >>=? fun store ->
-  Storage.get_genesis_time store >>= fun time ->
-  Storage.Current_timestamp.init_set store time >>=? fun store ->
   begin
     if from_genesis then
       Lwt.return store
diff --git a/src/proto/alpha/main.ml b/src/proto/alpha/main.ml
index 5003a901f..56417a362 100644
--- a/src/proto/alpha/main.ml
+++ b/src/proto/alpha/main.ml
@@ -17,10 +17,12 @@ let max_operation_data_length =
   Tezos_context.Operation.max_operation_data_length
 
 type block =
-  Tezos_context.Block.header
+  { header : Tezos_context.Block.header ;
+    pred_timestamp : Time.t }
 
-let parse_block =
-  Tezos_context.Block.parse_header
+let parse_block raw_header pred_timestamp =
+  Tezos_context.Block.parse_header raw_header >>? fun header ->
+  Ok { header ; pred_timestamp }
 
 let max_number_of_operations =
   Tezos_context.Constants.max_number_of_operations
@@ -30,7 +32,8 @@ let max_block_length =
 
 let rpc_services = Services_registration.rpc_services
 
-let apply ctxt header ops = Apply.apply ctxt true header ops
+let apply ctxt block ops =
+  Apply.apply ctxt true block.header block.pred_timestamp ops
 
 let preapply = Apply.preapply
 
diff --git a/src/proto/alpha/mining.ml b/src/proto/alpha/mining.ml
index 83c53e3fa..41d766945 100644
--- a/src/proto/alpha/mining.ml
+++ b/src/proto/alpha/mining.ml
@@ -19,8 +19,23 @@ type error +=
   | Bad_delegate
   | Invalid_slot_durations_constant
 
-let minimal_time c priority =
-  Timestamp.get_current c >>=? fun prev_timestamp ->
+let () =
+  register_error_kind
+    `Branch
+    ~id:"mining.too_early"
+    ~title:"Block forged too early"
+    ~description:"The block timestamp is before the first slot \
+                  for this miner at this level"
+    ~pp:(fun ppf (r, p) ->
+      Format.fprintf ppf "Block forged too early (%a is before %a)"
+                     Time.pp_hum p Time.pp_hum r)
+    Data_encoding.(obj2
+                     (req "minimal" Time.encoding)
+                     (req "provided" Time.encoding))
+    (function Too_early (r, p)   -> Some (r, p) | _ -> None)
+    (fun (r, p) -> Too_early (r, p))
+
+let minimal_time c priority pred_timestamp =
   let rec cumsum_slot_durations acc durations p =
     if Compare.Int32.(=) p 0l then
       ok acc
@@ -35,23 +50,24 @@ let minimal_time c priority =
          cumsum_slot_durations acc durations p in
   Lwt.return
     (cumsum_slot_durations
-       prev_timestamp (Constants.slot_durations c) priority)
+       pred_timestamp (Constants.slot_durations c) priority)
 
-let check_timestamp c priority timestamp =
-  minimal_time c priority >>=? fun minimal_time ->
+let check_timestamp c priority pred_timestamp =
+  minimal_time c priority pred_timestamp >>=? fun minimal_time ->
+  Tezos_context.Timestamp.get_current c >>= fun timestamp ->
   fail_unless Timestamp.(minimal_time <= timestamp)
     (Too_early (minimal_time, timestamp))
 
 let check_mining_rights c
-    { Block.shell = { timestamp } ;
-      proto = { mining_slot = (raw_level, priority) } } =
+    { Block.proto = { mining_slot = (raw_level, priority) } }
+    pred_timestamp =
   Level.current c >>=? fun current_level ->
   fail_unless
     Raw_level.(raw_level = current_level.level)
     (Invalid_level (current_level.Level.level, raw_level)) >>=? fun () ->
   let level = Level.from_raw c raw_level in
   Roll.mining_rights_owner c level ~priority >>=? fun delegate ->
-  check_timestamp c priority timestamp >>=? fun () ->
+  check_timestamp c priority pred_timestamp >>=? fun () ->
   return delegate
 
 let pay_mining_bond c
diff --git a/src/proto/alpha/mining.mli b/src/proto/alpha/mining.mli
index 57fe5bae3..7918c1140 100644
--- a/src/proto/alpha/mining.mli
+++ b/src/proto/alpha/mining.mli
@@ -14,7 +14,7 @@ open Misc
 val paying_priorities: context -> int32 list
 
 val minimal_time:
-  context -> int32 -> Time.t tzresult Lwt.t
+  context -> int32 -> Time.t -> Time.t tzresult Lwt.t
 
 val pay_mining_bond:
   context ->
@@ -25,13 +25,13 @@ val pay_mining_bond:
 val pay_endorsement_bond:
   context -> public_key_hash -> (context * Tez.t) tzresult Lwt.t
 
-(** [check_mining_rights] verifies that:
+(** [check_mining_rights ctxt block pred_timestamp] verifies that:
     * the contract that owned the roll at cycle start has the block signer as delegate.
     * the timestamp is coherent with the announced slot.
     * the bond have been payed if the slot is below [Constants.first_free_mining_slot].
 *)
 val check_mining_rights:
-  context -> Block.header -> public_key_hash tzresult Lwt.t
+  context -> Block.header -> Time.t -> public_key_hash tzresult Lwt.t
 
 (** [check_signing_rights c slot contract] verifies that:
     * the slot is valid;
diff --git a/src/proto/alpha/reward_storage.ml b/src/proto/alpha/reward_storage.ml
index 7886401b0..ef1a78759 100644
--- a/src/proto/alpha/reward_storage.ml
+++ b/src/proto/alpha/reward_storage.ml
@@ -56,7 +56,7 @@ let pay_rewards_for_cycle c cycle =
                 amount)
 
 let pay_due_rewards c =
-  Storage.Current_timestamp.get c >>=? fun timestamp ->
+  Storage.get_timestamp c >>= fun timestamp ->
   let rec loop c cycle =
     Storage.Rewards.Date.get_option c cycle >>=? function
     | None ->
diff --git a/src/proto/alpha/script_interpreter.ml b/src/proto/alpha/script_interpreter.ml
index deb0055d5..2092d2cd4 100644
--- a/src/proto/alpha/script_interpreter.ml
+++ b/src/proto/alpha/script_interpreter.ml
@@ -479,7 +479,7 @@ let rec interp
               Contract.get_balance ctxt source >>=? fun balance ->
               logged_return (Item (balance, rest), qta - 1, ctxt)
           | Now, rest ->
-              Timestamp.get_current ctxt >>=? fun now ->
+              Timestamp.get_current ctxt >>= fun now ->
               logged_return (Item (now, rest), qta - 1, ctxt)
           | Check_signature, Item (key, Item ((signature, message), rest)) ->
               Public_key.get ctxt key >>=? fun key ->
diff --git a/src/proto/alpha/services_registration.ml b/src/proto/alpha/services_registration.ml
index 3cb55919c..027ff0b12 100644
--- a/src/proto/alpha/services_registration.ml
+++ b/src/proto/alpha/services_registration.ml
@@ -174,7 +174,11 @@ let minimal_timestamp ctxt prio =
   let prio = match prio with None -> 0l | Some p -> Int32.of_int p in
   Mining.minimal_time ctxt prio
 
-let () = register1 Services.Helpers.minimal_timestamp minimal_timestamp
+let () = register1
+           Services.Helpers.minimal_timestamp
+           (fun ctxt slot ->
+             Tezos_context.Timestamp.get_current ctxt >>= fun timestamp ->
+             minimal_timestamp ctxt slot timestamp)
 
 let () =
   (* ctxt accept_failing_script miner_contract pred_block block_prio operation *)
@@ -299,10 +303,11 @@ let () =
          Lwt_list.filter_map_p (fun x -> x) @@
          List.mapi
            (fun prio c ->
+             Tezos_context.Timestamp.get_current ctxt >>= fun timestamp ->
               Mining.minimal_time
-                ctxt (Int32.of_int prio) >>= function
+                ctxt (Int32.of_int prio) timestamp >>= function
               | Error _ -> Lwt.return None
-              | Ok timestamp -> Lwt.return (Some (c, timestamp)))
+              | Ok minimal_timestamp -> Lwt.return (Some (c, minimal_timestamp)))
            slots
        end >>= fun timed_slots ->
        return (raw_level, timed_slots))
@@ -336,7 +341,8 @@ let mining_rights_for_delegate
       let raw_level = level.level in
       Lwt_list.map_p
         (fun priority ->
-           Mining.minimal_time ctxt priority >>= function
+          Tezos_context.Timestamp.get_current ctxt >>= fun timestamp ->
+           Mining.minimal_time ctxt priority timestamp >>= function
            | Ok time -> Lwt.return (raw_level, Int32.to_int priority, Some time)
                | Error _ -> Lwt.return (raw_level, Int32.to_int priority, None))
         priorities >>= fun priorities ->
diff --git a/src/proto/alpha/storage.ml b/src/proto/alpha/storage.ml
index f1e3fa75e..ed66dbf73 100644
--- a/src/proto/alpha/storage.ml
+++ b/src/proto/alpha/storage.ml
@@ -22,6 +22,10 @@ let get_fitness (c, _) = Context.get_fitness c
 let set_fitness (c, csts) v =
   Context.set_fitness c v >>= fun c -> Lwt.return (c, csts)
 
+let get_timestamp (c, _) = Context.get_timestamp c
+let set_commit_message (c, csts) msg =
+  Context.set_commit_message c msg >>= fun c -> Lwt.return (c, csts)
+
 let get_sandboxed c =
   Context.get c sandboxed_key >>= function
   | None -> return None
@@ -56,7 +60,6 @@ module Key = struct
   let store_root tail = version :: "store" :: tail
 
   let current_level = store_root ["level"]
-  let current_timestamp = store_root ["timestamp"]
   let current_fitness = store_root ["fitness"]
 
   let global_counter = store_root ["global_counter"]
@@ -139,14 +142,6 @@ module Current_level =
     let encoding = Raw_level_repr.encoding
   end)
 
-module Current_timestamp =
-  Make_single_data_storage(struct
-    type value = Time_repr.t
-    let name = "timestamp"
-    let key = Key.current_timestamp
-    let encoding = Time_repr.encoding
-  end)
-
 module Current_fitness =
   Make_single_data_storage(struct
     type value = int64
@@ -515,9 +510,6 @@ module Rewards = struct
 
 end
 
-let get_genesis_block (c, _) = Context.get_genesis_block c
-let get_genesis_time (c, _) = Context.get_genesis_time c
-
 let activate (c, constants) h =
   Updater.activate c h >>= fun c -> Lwt.return (c, constants)
 let fork_test_network (c, constants) =
diff --git a/src/proto/alpha/storage.mli b/src/proto/alpha/storage.mli
index 76e583e6d..731242152 100644
--- a/src/proto/alpha/storage.mli
+++ b/src/proto/alpha/storage.mli
@@ -37,6 +37,10 @@ val set_sandboxed : Context.t -> Data_encoding.json -> Context.t Lwt.t
 val get_fitness : t -> Fitness.fitness Lwt.t
 val set_fitness : t -> Fitness.fitness -> t Lwt.t
 
+val get_timestamp: t -> Time.t Lwt.t
+
+val set_commit_message: t -> string -> t Lwt.t
+
 val get_prevalidation : t -> bool Lwt.t
 val set_prevalidation : t -> t Lwt.t
 
@@ -51,11 +55,6 @@ module Current_level : Single_data_storage
   with type value = Raw_level_repr.t
    and type context := t
 
-(** The level of the current block *)
-module Current_timestamp : Single_data_storage
-  with type value = Time.t
-   and type context := t
-
 module Roll : sig
 
   (** Storage from this submodule must only be accessed through the
@@ -269,9 +268,6 @@ module Rewards : sig
 
 end
 
-val get_genesis_time: t -> Time.t Lwt.t
-val get_genesis_block: t -> Block_hash.t Lwt.t
-
 val activate: t -> Protocol_hash.t -> t Lwt.t
 val set_test_protocol: t -> Protocol_hash.t -> t Lwt.t
 val fork_test_network: t -> t Lwt.t
diff --git a/src/proto/alpha/tezos_context.ml b/src/proto/alpha/tezos_context.ml
index 0f82d29cc..99a5fc254 100644
--- a/src/proto/alpha/tezos_context.ml
+++ b/src/proto/alpha/tezos_context.ml
@@ -19,13 +19,12 @@ end
 
 module Tez = Tez_repr
 module Period = Period_repr
+
 module Timestamp = struct
   include Time_repr
-  let get_current = Storage.Current_timestamp.get
-  let set_current = Storage.Current_timestamp.set
+  let get_current = Storage.get_timestamp
 end
 
-
 include Operation_repr
 module Operation = Operation_repr
 module Block = Block_repr
@@ -121,7 +120,15 @@ end
 module Asset = Asset_repr
 
 let init = Init_storage.may_initialize
-let finalize c = return (Storage.recover c)
+
+let finalize ?commit_message c =
+  match commit_message with
+  | None ->
+     return (Storage.recover c)
+  | Some msg ->
+     Storage.set_commit_message c msg >>= fun c ->
+     return (Storage.recover c)
+
 let configure_sandbox = Init_storage.configure_sandbox
 let get_prevalidation = Storage.get_prevalidation
 let set_prevalidation = Storage.set_prevalidation
diff --git a/src/proto/alpha/tezos_context.mli b/src/proto/alpha/tezos_context.mli
index 20bab0382..9b24a810f 100644
--- a/src/proto/alpha/tezos_context.mli
+++ b/src/proto/alpha/tezos_context.mli
@@ -68,8 +68,7 @@ module Timestamp : sig
   val of_seconds: string -> time option
   val to_seconds: time -> string
 
-  val set_current: context -> Time.t -> context tzresult Lwt.t
-  val get_current: context -> Time.t tzresult Lwt.t
+  val get_current: context -> Time.t Lwt.t
 
 end
 
@@ -581,7 +580,7 @@ module Reward : sig
 end
 
 val init: Context.t -> context tzresult Lwt.t
-val finalize: context -> Context.t tzresult Lwt.t
+val finalize: ?commit_message:string -> context -> Context.t tzresult Lwt.t
 
 val configure_sandbox:
   Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t
diff --git a/src/proto/demo/main.ml b/src/proto/demo/main.ml
index e4b578b0b..71fe59bf9 100644
--- a/src/proto/demo/main.ml
+++ b/src/proto/demo/main.ml
@@ -15,7 +15,7 @@ type block = unit
 let max_block_length = 42
 let max_number_of_operations = 42
 
-let parse_block _ = Ok ()
+let parse_block _ _pred_timestamp = Ok ()
 let parse_operation h _ = Ok h
 
 module Fitness = struct
@@ -66,9 +66,13 @@ end
 
 let apply ctxt () _operations =
   Fitness.increase ctxt >>=? fun ctxt ->
+  Fitness.get ctxt >>=? fun fitness ->
+  let commit_message =
+    Format.asprintf "fitness <- %Ld" fitness in
+  Context.set_commit_message ctxt commit_message >>= fun ctxt ->
   return ctxt
 
-let preapply context _block_pred _timestamp _sort operations =
+let preapply context _block_pred _sort operations =
   Lwt.return
     (Ok
        (context,
diff --git a/src/proto/environment/context.mli b/src/proto/environment/context.mli
index f9ccae1d5..fa5920f69 100644
--- a/src/proto/environment/context.mli
+++ b/src/proto/environment/context.mli
@@ -8,8 +8,8 @@ include Persist.STORE
 val get_fitness: t -> Fitness.fitness Lwt.t
 val set_fitness: t -> Fitness.fitness -> t Lwt.t
 
-val get_genesis_time: t -> Time.t Lwt.t
-val get_genesis_block: t -> Block_hash.t Lwt.t
+val get_timestamp: t -> Time.t Lwt.t
+val set_commit_message: t -> string -> t Lwt.t
 
 val register_resolver:
   'a Base58.encoding -> (t -> string -> 'a list Lwt.t) -> unit
diff --git a/src/proto/environment/updater.mli b/src/proto/environment/updater.mli
index 492b3ec34..48d4dd936 100644
--- a/src/proto/environment/updater.mli
+++ b/src/proto/environment/updater.mli
@@ -83,8 +83,9 @@ module type PROTOCOL = sig
       produce a pre-decomposed value of the high level, protocol defined
       {!block} type. It does not have access to the storage
       context. It may store the hash and raw bytes for later signature
-      verification by {!apply} or {!preapply}. *)
-  val parse_block : raw_block -> block tzresult
+      verification by {!apply} or {!preapply}. The timestamp of the
+      predecessor block is also provided for early delay checks. *)
+  val parse_block : raw_block -> Time.t -> block tzresult
 
   (** The parsing / preliminary validation function for
       operations. Similar to {!parse_block}. *)
@@ -100,14 +101,13 @@ module type PROTOCOL = sig
   (** The auxiliary protocol entry point that validates pending
       operations out of blocks. This function tries to apply the all
       operations in the given order, and returns which applications have
-      suceeded and which ones have failed. The first three parameters
-      are a context in which to apply the operations, the hash of the
-      preceding block and the date at which the operations are
-      executed. This function is used by the shell for accepting or
+      suceeded and which ones have failed. The first two parameters
+      are a context in which to apply the operations and the hash of the
+      preceding block. This function is used by the shell for accepting or
       dropping operations, as well as the mining client to check that a
       sequence of operations forms a valid block. *)
   val preapply :
-    Context.t -> Block_hash.t -> Time.t -> bool -> operation list ->
+    Context.t -> Block_hash.t -> bool -> operation list ->
     (Context.t * error preapply_result) tzresult Lwt.t
 
   (** The list of remote procedures exported by this implementation *)
diff --git a/src/proto/genesis/main.ml b/src/proto/genesis/main.ml
index e1433ef51..df315dc00 100644
--- a/src/proto/genesis/main.ml
+++ b/src/proto/genesis/main.ml
@@ -48,7 +48,7 @@ let max_block_length =
   | None -> assert false
   | Some len -> len
 
-let parse_block { Updater.shell ; proto } : block tzresult =
+let parse_block { Updater.shell ; proto } _pred_timestamp : block tzresult =
   match Data_encoding.Binary.of_bytes Data.Command.signed_encoding proto with
   | None -> Error [Parsing_error]
   | Some (command, signature) -> Ok { shell ; command ; signature }
@@ -66,14 +66,20 @@ let apply ctxt header _ops =
   Context.set_fitness ctxt header.shell.fitness >>= fun ctxt ->
   match header.command with
   | Activate hash ->
+      let commit_message =
+        Format.asprintf "activate %a" Protocol_hash.pp_short hash in
+      Context.set_commit_message ctxt commit_message >>= fun ctxt ->
       Updater.activate ctxt hash >>= fun ctxt ->
       return ctxt
   | Activate_testnet hash ->
+      let commit_message =
+        Format.asprintf "activate testnet %a" Protocol_hash.pp_short hash in
+      Context.set_commit_message ctxt commit_message >>= fun ctxt ->
       Updater.set_test_protocol ctxt hash >>= fun ctxt ->
       Updater.fork_test_network ctxt >>= fun ctxt ->
       return ctxt
 
-let preapply ctxt _block_pred _timestamp _sort _ops =
+let preapply ctxt _block_pred _sort _ops =
   return ( ctxt,
            { Updater.applied = [] ;
              refused = Operation_hash.Map.empty ;
diff --git a/test/test_context.ml b/test/test_context.ml
index 107242fc6..a1b32950f 100644
--- a/test/test_context.ml
+++ b/test/test_context.ml
@@ -41,17 +41,6 @@ let block2 =
   Block_hash.of_hex_exn
     "2222222222222222222222222222222222222222222222222222222222222222"
 
-let faked_block : Store.Block_header.t = {
-  shell = {
-    net_id ;
-    predecessor = genesis_block ;
-    operations = [] ;
-    fitness = [] ;
-    timestamp = Time.of_seconds 0L ;
-  } ;
-  proto = MBytes.of_string "" ;
-}
-
 let create_block2 idx =
   checkout idx genesis_block >>= function
   | None ->
@@ -60,7 +49,7 @@ let create_block2 idx =
       set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt ->
       set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt ->
       set ctxt ["version";] (MBytes.of_string "0.0") >>= fun ctxt ->
-      commit faked_block block2 ctxt
+      commit block2 ctxt
 
 let block3a =
   Block_hash.of_hex_exn
@@ -73,7 +62,7 @@ let create_block3a idx =
   | Some ctxt ->
       del ctxt ["a"; "b"] >>= fun ctxt ->
       set ctxt ["a"; "d"] (MBytes.of_string "Mars") >>= fun ctxt ->
-      commit faked_block block3a ctxt
+      commit block3a ctxt
 
 let block3b =
   Block_hash.of_hex_exn
@@ -90,7 +79,7 @@ let create_block3b idx =
   | Some ctxt ->
       del ctxt ["a"; "c"] >>= fun ctxt ->
       set ctxt ["a"; "d"] (MBytes.of_string "Février") >>= fun ctxt ->
-      commit faked_block block3b ctxt
+      commit block3b ctxt
 
 let wrap_context_init f base_dir =
   let root = base_dir // "context" in
diff --git a/test/test_state.ml b/test/test_state.ml
index 1561e1a96..2ce173a8a 100644
--- a/test/test_state.ml
+++ b/test/test_state.ml
@@ -129,7 +129,7 @@ let build_valid_chain state tbl vtbl otbl pred names =
          State.Block_header.read_opt state hash >>= fun block' ->
          Assert.equal_block ~msg:__LOC__ (Some block) block' ;
          Hashtbl.add tbl name (hash, block) ;
-         Lwt.return (Proto.parse_block block) >>=? fun block ->
+         Lwt.return (Proto.parse_block block pred.timestamp) >>=? fun block ->
          Proto.apply pred.context block [] >>=? fun ctxt ->
          State.Valid_block.store state hash ctxt >>=? fun _vblock ->
          State.Valid_block.read state hash >>=? fun vblock ->