Client/Endorser: simpler state

src/proto_alpha/lib_baking/client_baking_endorsement.ml

@@ -106,12 +106,19 @@ let check_endorsement cctxt level pkh =
       else
         return ()
 
+let previously_endorsed_level cctxt pkh new_lvl  =
+  State.get_endorsement cctxt pkh  >>=? function
+  | None -> return false
+  | Some last_lvl ->
+      return (not Raw_level.(last_lvl < new_lvl))
+
 let forge_endorsement (cctxt : #Proto_alpha.full)
-    ?(chain = `Main) block
+    ?(chain = `Main) block ?async
     ~src_sk  ?slots src_pk =
   let src_pkh = Signature.Public_key.hash src_pk in
   Alpha_block_services.metadata cctxt
     ~chain ~block () >>=? fun { protocol_data = { level = { level } } } ->
+  check_endorsement cctxt level src_pkh >>=? fun () ->
   begin
     match slots with
     | Some slots -> return slots
@@ -122,7 +129,7 @@ let forge_endorsement (cctxt : #Proto_alpha.full)
         | slots -> return slots
   end >>=? fun slots ->
   check_endorsement cctxt level src_pkh >>=? fun () ->
-  inject_endorsement cctxt ~chain block level src_sk slots src_pkh
+  inject_endorsement cctxt ~chain ?async block level src_sk slots src_pkh
 
 (** Worker *)
 
@@ -166,7 +173,7 @@ let drop_old_endorsement ~before state =
       (fun { block } -> Fitness.compare before block.fitness <= 0)
       state.to_endorse
 
-let schedule_endorsements (cctxt : #Proto_alpha.full) state bi =
+let schedule_endorsements (cctxt : #Proto_alpha.full) ~(max_past:Time.t) state bis =
   let may_endorse (block: Client_baking_blocks.block_info) delegate time =
     Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
     lwt_log_info "May endorse block %a for %s"
@@ -176,7 +183,11 @@ let schedule_endorsements (cctxt : #Proto_alpha.full) state bi =
     get_signing_slots cctxt b delegate level >>=? fun slots ->
     lwt_debug "Found %d slots for %a/%s"
       (List.length slots) Block_hash.pp_short block.hash name >>= fun () ->
-
+    previously_endorsed_level cctxt delegate level >>=? function
+    | true ->
+        lwt_debug "Level %a : previously endorsed."
+          Raw_level.pp level >>= return
+    | false ->
         if Fitness.compare state.best.fitness block.fitness < 0 then begin
           state.best <- block ;
           drop_old_endorsement ~before:block.fitness state ;
@@ -222,15 +233,17 @@ let schedule_endorsements (cctxt : #Proto_alpha.full) state bi =
             return ()
         end
   in
-
   let time = Time.(add (now ()) state.delay) in
   get_delegates cctxt state >>=? fun delegates ->
+
+  ignore max_past;
+
   iter_s
-    (fun delegate -> may_endorse bi delegate time)
+    (fun delegate -> may_endorse bis delegate time)
     delegates
 
-let schedule_endorsements (cctxt : #Proto_alpha.full) state bis =
-  schedule_endorsements cctxt state bis >>= function
+let schedule_endorsements (cctxt : #Proto_alpha.full) ~max_past state bis =
+  schedule_endorsements cctxt ~max_past state bis >>= function
   | Error exns ->
       lwt_log_error
         "@[<v 2>Error(s) while scheduling endorsements@,%a@]"
@@ -279,7 +292,8 @@ let compute_timeout state =
       else
         Lwt_unix.sleep (Int64.to_float delay)
 
-let create (cctxt : #Proto_alpha.full) ~delay contracts block_stream =
+
+let create (cctxt : #Proto_alpha.full) ?(max_past=(Time.of_seconds 110L)) ~delay contracts block_stream =
   lwt_log_info "Starting endorsement daemon" >>= fun () ->
   Lwt_stream.get block_stream >>= function
   | None | Some (Error _) ->
@@ -303,7 +317,7 @@ let create (cctxt : #Proto_alpha.full) ~delay contracts block_stream =
         | `Hash (Some (Ok bi)) ->
             Lwt.cancel timeout ;
             last_get_block := None ;
-            schedule_endorsements cctxt state bi >>= fun () ->
+            schedule_endorsements cctxt ~max_past state bi >>= fun () ->
             worker_loop ()
         | `Timeout ->
             begin
@@ -316,5 +330,6 @@ let create (cctxt : #Proto_alpha.full) ~delay contracts block_stream =
                   Lwt.return_unit
             end >>= fun () ->
             worker_loop () in
-      schedule_endorsements cctxt state head >>= fun () ->
+
+      schedule_endorsements cctxt  ~max_past state head >>= fun () ->
       worker_loop ()

src/proto_alpha/lib_baking/client_baking_endorsement.mli

@@ -14,6 +14,7 @@ val forge_endorsement:
   #Proto_alpha.full ->
   ?chain:Chain_services.chain ->
   Block_services.block ->
+  ?async: bool ->
   src_sk:Client_keys.sk_uri ->
   ?slots:int list ->
   public_key ->
@@ -21,6 +22,7 @@ val forge_endorsement:
 
 val create :
   #Proto_alpha.full ->
+  ?max_past:Time.t ->
   delay:int ->
   public_key_hash list ->
   Client_baking_blocks.block_info tzresult Lwt_stream.t -> unit Lwt.t