Accuser: include suggested modifications

This commit is contained in:
Vincent Botbol 2018-06-26 10:30:26 +02:00
parent babb457354
commit ffcd0a0c09

View File

@ -27,22 +27,16 @@ type state = {
(* Blocks received so far *) (* Blocks received so far *)
blocks_table : Block_hash.t Delegate_Map.t HLevel.t ; blocks_table : Block_hash.t Delegate_Map.t HLevel.t ;
(* Maximum delta of level to register *) (* Maximum delta of level to register *)
preserved_levels : Raw_level.t ; preserved_levels : int ;
(* Highest level seen in a block *) (* Highest level seen in a block *)
mutable highest_level_encountered : Raw_level.t ; mutable highest_level_encountered : Raw_level.t ;
} }
let create_state ~preserved_levels = let create_state ~preserved_levels =
Alpha_environment.wrap_error @@ Raw_level.of_int32 (Int32.of_int preserved_levels) Lwt.return { endorsements_table = HLevel.create preserved_levels ;
|> function blocks_table = HLevel.create preserved_levels ;
| Error errs -> preserved_levels ;
lwt_log_error "Bad preserved_levels conversion : %a" pp_print_error errs >>= highest_level_encountered = Raw_level.root (* 0l *) }
exit 2
| Ok raw_level_preserved_levels ->
Lwt.return { endorsements_table = HLevel.create preserved_levels ;
blocks_table = HLevel.create preserved_levels ;
preserved_levels = raw_level_preserved_levels ;
highest_level_encountered = Raw_level.root (* 0l *) }
(* get the delegate that had the right to bake for a specific level/slot *) (* get the delegate that had the right to bake for a specific level/slot *)
let fetch_baker (cctxt : #Proto_alpha.full) ~chain ~block = let fetch_baker (cctxt : #Proto_alpha.full) ~chain ~block =
@ -50,14 +44,16 @@ let fetch_baker (cctxt : #Proto_alpha.full) ~chain ~block =
{ protocol_data = { Alpha_context.Block_header.baker } } -> { protocol_data = { Alpha_context.Block_header.baker } } ->
return baker return baker
(* We choose a previous offset (5 blocks from head) to ensure that the
injected operation is branched from a valid predecessor. *)
let get_block_offset level = let get_block_offset level =
Alpha_environment.wrap_error @@ match Alpha_environment.wrap_error (Raw_level.of_int32 5l) with
Raw_level.of_int32 6l |> function
| Ok min_level -> | Ok min_level ->
begin if Raw_level.(level <= min_level) then Lwt.return
Lwt.return (`Head 0) (if Raw_level.(level < min_level) then
else `Head 0
Lwt.return (`Head 5) end else
`Head 5)
| Error errs -> | Error errs ->
lwt_log_error "Invalid level conversion : %a" pp_print_error errs >>= fun () -> lwt_log_error "Invalid level conversion : %a" pp_print_error errs >>= fun () ->
Lwt.return (`Head 0) Lwt.return (`Head 0)
@ -141,25 +137,26 @@ let process_block (cctxt : #Proto_alpha.full) state ~chain (header : Alpha_block
(* Remove levels that are lower than the [highest_level_encountered] minus [preserved_levels] *) (* Remove levels that are lower than the [highest_level_encountered] minus [preserved_levels] *)
let cleanup_old_operations state = let cleanup_old_operations state =
let diff = Raw_level.diff state.highest_level_encountered state.preserved_levels in let highest_level_encountered =
Alpha_environment.wrap_error @@ begin if Int32.compare diff Int32.zero < 0 then Int32.to_int (Raw_level.to_int32 state.highest_level_encountered)
Alpha_environment.Error_monad.ok Raw_level.root in
let diff = highest_level_encountered - state.preserved_levels in
let threshold = begin if diff < 0 then
Raw_level.root
else else
Raw_level.of_int32 diff Raw_level.of_int32 (Int32.of_int diff) |> function
end |> function | Ok threshold -> threshold
| Error errs -> | Error _ -> Raw_level.root
lwt_log_error "Bad conversion : %a" pp_print_error errs >>= end in
Lwt.return let filter hmap =
| Ok threshold -> HLevel.filter_map_inplace (fun level x ->
let filter hmap = if Raw_level.(level < threshold) then
HLevel.filter_map_inplace (fun level x -> None
if Raw_level.(level < threshold) then else
None Some x
else ) hmap in
Some x filter state.endorsements_table ; filter state.blocks_table ;
) hmap in ()
filter state.endorsements_table ; filter state.blocks_table ;
Lwt.return ()
let endorsements_index = 0 let endorsements_index = 0
@ -200,7 +197,7 @@ let process_new_block (cctxt : #Proto_alpha.full) state { hash ; chain_id ; leve
pp_print_error errs >>= fun () -> pp_print_error errs >>= fun () ->
return () return ()
end >>=? fun () -> end >>=? fun () ->
cleanup_old_operations state >>= fun () -> cleanup_old_operations state ;
return () return ()
let create (cctxt : #Proto_alpha.full) ~preserved_levels valid_blocks_stream = let create (cctxt : #Proto_alpha.full) ~preserved_levels valid_blocks_stream =