Alpha/Accuser: add a new accuser adapted to the new daemon framework
This commit is contained in:
parent
aa95ee8332
commit
b2194fa27d
@ -15,6 +15,7 @@ type error += Bad_tez_arg of string * string (* Arg_name * value *)
|
|||||||
type error += Bad_max_priority of string
|
type error += Bad_max_priority of string
|
||||||
type error += Bad_fee_threshold of string
|
type error += Bad_fee_threshold of string
|
||||||
type error += Bad_endorsement_delay of string
|
type error += Bad_endorsement_delay of string
|
||||||
|
type error += Bad_preserved_levels of string
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
register_error_kind
|
register_error_kind
|
||||||
@ -60,7 +61,17 @@ let () =
|
|||||||
Format.fprintf ppf "Bad argument value for -endorsement-delay. Expected an integer, but given '%s'" literal)
|
Format.fprintf ppf "Bad argument value for -endorsement-delay. Expected an integer, but given '%s'" literal)
|
||||||
Data_encoding.(obj1 (req "parameter" string))
|
Data_encoding.(obj1 (req "parameter" string))
|
||||||
(function Bad_endorsement_delay parameter -> Some parameter | _ -> None)
|
(function Bad_endorsement_delay parameter -> Some parameter | _ -> None)
|
||||||
(fun parameter -> Bad_endorsement_delay parameter)
|
(fun parameter -> Bad_endorsement_delay parameter) ;
|
||||||
|
register_error_kind
|
||||||
|
`Permanent
|
||||||
|
~id:"badPreservedLevelsArg"
|
||||||
|
~title:"Bad -preserved-levels arg"
|
||||||
|
~description:("invalid number of levels in -preserved-levels")
|
||||||
|
~pp:(fun ppf literal ->
|
||||||
|
Format.fprintf ppf "Bad argument value for -preserved_levels. Expected a positive integer, but given '%s'" literal)
|
||||||
|
Data_encoding.(obj1 (req "parameter" string))
|
||||||
|
(function Bad_preserved_levels parameter -> Some parameter | _ -> None)
|
||||||
|
(fun parameter -> Bad_preserved_levels parameter)
|
||||||
|
|
||||||
|
|
||||||
let tez_sym =
|
let tez_sym =
|
||||||
@ -218,6 +229,21 @@ let endorsement_delay_arg =
|
|||||||
try return (int_of_string s)
|
try return (int_of_string s)
|
||||||
with _ -> fail (Bad_endorsement_delay s)))
|
with _ -> fail (Bad_endorsement_delay s)))
|
||||||
|
|
||||||
|
let preserved_levels_arg =
|
||||||
|
default_arg
|
||||||
|
~long:"preserved-levels"
|
||||||
|
~placeholder:"threshold"
|
||||||
|
~doc:"Number of effective levels kept in the accuser's memory"
|
||||||
|
~default:"200"
|
||||||
|
(parameter (fun _ s ->
|
||||||
|
try
|
||||||
|
let preserved_cycles = int_of_string s in
|
||||||
|
if preserved_cycles < 0 then
|
||||||
|
fail (Bad_preserved_levels s)
|
||||||
|
else
|
||||||
|
return preserved_cycles
|
||||||
|
with _ -> fail (Bad_preserved_levels s)))
|
||||||
|
|
||||||
let no_print_source_flag =
|
let no_print_source_flag =
|
||||||
switch
|
switch
|
||||||
~long:"no-print-source"
|
~long:"no-print-source"
|
||||||
|
@ -27,6 +27,7 @@ val fee_threshold_arg: (Tez.tez option, Proto_alpha.full) Clic.arg
|
|||||||
val force_switch: (bool, Proto_alpha.full) Clic.arg
|
val force_switch: (bool, Proto_alpha.full) Clic.arg
|
||||||
val minimal_timestamp_switch: (bool, Proto_alpha.full) Clic.arg
|
val minimal_timestamp_switch: (bool, Proto_alpha.full) Clic.arg
|
||||||
val endorsement_delay_arg: (int, Proto_alpha.full) Clic.arg
|
val endorsement_delay_arg: (int, Proto_alpha.full) Clic.arg
|
||||||
|
val preserved_levels_arg: (int, Proto_alpha.full) Clic.arg
|
||||||
|
|
||||||
val no_print_source_flag: (bool, Proto_alpha.full) Clic.arg
|
val no_print_source_flag: (bool, Proto_alpha.full) Clic.arg
|
||||||
val no_confirmation: (bool, Proto_alpha.full) Clic.arg
|
val no_confirmation: (bool, Proto_alpha.full) Clic.arg
|
||||||
|
@ -45,7 +45,7 @@ let info cctxt ?(chain = `Main) block =
|
|||||||
raw_info cctxt ~chain hash shell_header
|
raw_info cctxt ~chain hash shell_header
|
||||||
|
|
||||||
let monitor_valid_blocks cctxt ?chains ?protocols ?next_protocols () =
|
let monitor_valid_blocks cctxt ?chains ?protocols ?next_protocols () =
|
||||||
Shell_services.Monitor.valid_blocks cctxt
|
Monitor_services.valid_blocks cctxt
|
||||||
?chains ?protocols ?next_protocols () >>=? fun (block_stream, _stop) ->
|
?chains ?protocols ?next_protocols () >>=? fun (block_stream, _stop) ->
|
||||||
return (Lwt_stream.map_s
|
return (Lwt_stream.map_s
|
||||||
(fun ((chain, block), { Tezos_base.Block_header.shell }) ->
|
(fun ((chain, block), { Tezos_base.Block_header.shell }) ->
|
||||||
|
@ -9,37 +9,226 @@
|
|||||||
|
|
||||||
include Logging.Make(struct let name = "client.denunciation" end)
|
include Logging.Make(struct let name = "client.denunciation" end)
|
||||||
|
|
||||||
let create cctxt endorsement_stream =
|
open Proto_alpha
|
||||||
|
open Alpha_context
|
||||||
|
|
||||||
let never_ends = Lwt_utils.never_ending () in
|
open Client_baking_blocks
|
||||||
|
|
||||||
let event_k cctxt () e =
|
module HLevel = Hashtbl.Make(struct
|
||||||
(* TODO: more than just logging *)
|
include Raw_level
|
||||||
Client_keys.Public_key_hash.name
|
let hash lvl = Int32.to_int (to_int32 lvl)
|
||||||
cctxt
|
end)
|
||||||
e.Client_baking_operations.source >>= function
|
|
||||||
| Ok source ->
|
module Delegate_Map = Map.Make(Signature.Public_key_hash)
|
||||||
lwt_debug
|
|
||||||
"Discovered endorsement for block %a by %s (slot @[<h>%a@])"
|
type state = {
|
||||||
Block_hash.pp_short e.block
|
(* Endorsements seen so far *)
|
||||||
source
|
endorsements_table : Kind.endorsement operation Delegate_Map.t HLevel.t ;
|
||||||
Format.(pp_print_list pp_print_int) e.slots >>= fun () ->
|
(* Blocks received so far *)
|
||||||
return ()
|
blocks_table : Block_hash.t Delegate_Map.t HLevel.t ;
|
||||||
|
(* Maximum delta of level to register *)
|
||||||
|
preserved_levels : Raw_level.t ;
|
||||||
|
(* Highest level seen in a block *)
|
||||||
|
mutable highest_level_encountered : Raw_level.t ;
|
||||||
|
}
|
||||||
|
|
||||||
|
let create_state ~preserved_levels =
|
||||||
|
Alpha_environment.wrap_error @@ Raw_level.of_int32 (Int32.of_int preserved_levels)
|
||||||
|
|> function
|
||||||
| Error errs ->
|
| Error errs ->
|
||||||
lwt_log_error "Error whilst checking the endorsment %a/%a:@\n%a"
|
lwt_log_error "Bad preserved_levels conversion : %a" pp_print_error errs >>=
|
||||||
Block_hash.pp_short e.block
|
exit 2
|
||||||
Format.(pp_print_list pp_print_int) e.slots
|
| 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 *)
|
||||||
|
let fetch_baker (cctxt : #Proto_alpha.full) ~chain ~block =
|
||||||
|
Alpha_block_services.metadata cctxt ~chain ~block () >>=? fun
|
||||||
|
{ protocol_data = { Alpha_context.Block_header.baker } } ->
|
||||||
|
return baker
|
||||||
|
|
||||||
|
let get_block_offset level =
|
||||||
|
Alpha_environment.wrap_error @@
|
||||||
|
Raw_level.of_int32 6l |> function
|
||||||
|
| Ok min_level ->
|
||||||
|
begin if Raw_level.(level <= min_level) then
|
||||||
|
Lwt.return (`Head 0)
|
||||||
|
else
|
||||||
|
Lwt.return (`Head 5) end
|
||||||
|
| Error errs ->
|
||||||
|
lwt_log_error "Invalid level conversion : %a" pp_print_error errs >>= fun () ->
|
||||||
|
Lwt.return (`Head 0)
|
||||||
|
|
||||||
|
let process_endorsements (cctxt : #Proto_alpha.full) state ~chain
|
||||||
|
(endorsements : Alpha_block_services.operation list) level =
|
||||||
|
iter_s (fun { Alpha_block_services.shell ; receipt ; hash ; protocol_data ; _ } ->
|
||||||
|
match protocol_data, receipt with
|
||||||
|
| (Operation_data ({ contents = Single (Endorsement _) ; _ } as protocol_data)),
|
||||||
|
Apply_operation_result.(
|
||||||
|
Operation_metadata { contents = Single_result (Endorsement_result { delegate ; _ }) }) ->
|
||||||
|
let new_endorsement : Kind.endorsement Alpha_context.operation = { shell ; protocol_data } in
|
||||||
|
let map = match HLevel.find_opt state.endorsements_table level with
|
||||||
|
| None -> Delegate_Map.empty
|
||||||
|
| Some x -> x in
|
||||||
|
(* If a previous endorsement made by this pkh is found for
|
||||||
|
the same level we inject a double_endorsement *)
|
||||||
|
begin match Delegate_Map.find_opt delegate map with
|
||||||
|
| None -> return @@ HLevel.add state.endorsements_table level
|
||||||
|
(Delegate_Map.add delegate new_endorsement map)
|
||||||
|
| Some existing_endorsement ->
|
||||||
|
get_block_offset level >>= fun block ->
|
||||||
|
(* TODO : verify that the chains are coherent *)
|
||||||
|
Alpha_block_services.hash cctxt ~chain:`Main ~block () >>=? fun block_hash ->
|
||||||
|
Alpha_services.Forge.double_endorsement_evidence
|
||||||
|
cctxt (`Main, block) ~branch:block_hash
|
||||||
|
~op1:existing_endorsement
|
||||||
|
~op2:new_endorsement () >>=? fun bytes ->
|
||||||
|
let bytes = Signature.concat bytes Signature.zero in
|
||||||
|
lwt_log_notice "Double endorsement detected" >>= fun () ->
|
||||||
|
(* A denunciation may have already occured *)
|
||||||
|
Shell_services.Injection.operation cctxt ~chain bytes >>=? fun op_hash ->
|
||||||
|
lwt_log_notice "Double endorsement evidence injected %a"
|
||||||
|
Operation_hash.pp op_hash >>= fun () ->
|
||||||
|
return @@ HLevel.replace state.endorsements_table level
|
||||||
|
(Delegate_Map.add delegate new_endorsement map)
|
||||||
|
end
|
||||||
|
| _ ->
|
||||||
|
lwt_log_error "Inconsistent endorsement found %a"
|
||||||
|
Operation_hash.pp hash >>= fun () ->
|
||||||
|
return ()
|
||||||
|
) endorsements >>=? fun () ->
|
||||||
|
return ()
|
||||||
|
|
||||||
|
let process_block (cctxt : #Proto_alpha.full) state ~chain (header : Alpha_block_services.block_info) =
|
||||||
|
let { Alpha_block_services.hash ; metadata = { protocol_data = { baker ; level = { level } } } } = header in
|
||||||
|
let map = match HLevel.find_opt state.blocks_table level with
|
||||||
|
| None -> Delegate_Map.empty
|
||||||
|
| Some x -> x in
|
||||||
|
begin match Delegate_Map.find_opt baker map with
|
||||||
|
| None -> return @@ HLevel.add state.blocks_table level
|
||||||
|
(Delegate_Map.add baker hash map)
|
||||||
|
| Some existing_hash when Block_hash.(=) existing_hash hash ->
|
||||||
|
(* This case should never happen *)
|
||||||
|
lwt_debug "Double baking detected but block hashes are equivalent. Skipping..." >>= fun () ->
|
||||||
|
return @@ HLevel.replace state.blocks_table level
|
||||||
|
(Delegate_Map.add baker hash map)
|
||||||
|
| Some existing_hash ->
|
||||||
|
(* If a previous endorsement made by this pkh is found for
|
||||||
|
the same level we inject a double_endorsement *)
|
||||||
|
(* TODO : verify that the chains are coherent *)
|
||||||
|
Alpha_block_services.header cctxt ~chain ~block:(`Hash (existing_hash, 0)) () >>=?
|
||||||
|
fun ( { shell ; protocol_data } : Alpha_block_services.block_header) ->
|
||||||
|
let bh1 = { Alpha_context.Block_header.shell = shell ; protocol_data = protocol_data } in
|
||||||
|
Alpha_block_services.header cctxt ~chain ~block:(`Hash (hash, 0)) () >>=?
|
||||||
|
fun ( { shell ; protocol_data } : Alpha_block_services.block_header) ->
|
||||||
|
let bh2 = { Alpha_context.Block_header.shell = shell ; protocol_data = protocol_data } in
|
||||||
|
get_block_offset level >>= fun block ->
|
||||||
|
Alpha_block_services.hash cctxt ~chain:`Main ~block () >>=? fun block_hash ->
|
||||||
|
Alpha_services.Forge.double_baking_evidence cctxt (`Main, block) ~branch:block_hash
|
||||||
|
~bh1 ~bh2 () >>=? fun bytes ->
|
||||||
|
let bytes = Signature.concat bytes Signature.zero in
|
||||||
|
lwt_log_notice "Double baking detected" >>= fun () ->
|
||||||
|
(* A denunciation may have already occured *)
|
||||||
|
Shell_services.Injection.operation cctxt ~chain bytes >>=? fun op_hash ->
|
||||||
|
lwt_log_notice "Double baking evidence injected %a"
|
||||||
|
Operation_hash.pp op_hash >>= fun () ->
|
||||||
|
return @@ HLevel.replace state.blocks_table level
|
||||||
|
(Delegate_Map.add baker hash map)
|
||||||
|
end
|
||||||
|
|
||||||
|
(* Remove levels that are lower than the [highest_level_encountered] minus [preserved_levels] *)
|
||||||
|
let cleanup_old_operations state =
|
||||||
|
let diff = Raw_level.diff state.highest_level_encountered state.preserved_levels in
|
||||||
|
Alpha_environment.wrap_error @@ begin if Int32.compare diff Int32.zero < 0 then
|
||||||
|
Alpha_environment.Error_monad.ok Raw_level.root
|
||||||
|
else
|
||||||
|
Raw_level.of_int32 diff
|
||||||
|
end |> function
|
||||||
|
| Error errs ->
|
||||||
|
lwt_log_error "Bad conversion : %a" pp_print_error errs >>=
|
||||||
|
Lwt.return
|
||||||
|
| Ok threshold ->
|
||||||
|
let filter hmap =
|
||||||
|
HLevel.filter_map_inplace (fun level x ->
|
||||||
|
if Raw_level.(level < threshold) then
|
||||||
|
None
|
||||||
|
else
|
||||||
|
Some x
|
||||||
|
) hmap in
|
||||||
|
filter state.endorsements_table ; filter state.blocks_table ;
|
||||||
|
Lwt.return ()
|
||||||
|
|
||||||
|
let endorsements_index = 0
|
||||||
|
|
||||||
|
(* Each new block is processed :
|
||||||
|
- Checking that every endorser operated only once at this level
|
||||||
|
- Checking that every baker injected only once at this level
|
||||||
|
*)
|
||||||
|
let process_new_block (cctxt : #Proto_alpha.full) state { hash ; chain_id ; level ; protocol ; next_protocol } =
|
||||||
|
if Protocol_hash.(protocol <> next_protocol) then
|
||||||
|
lwt_log_error "Protocol changing detected. Skipping the block." >>= fun () ->
|
||||||
|
return ()
|
||||||
|
else
|
||||||
|
lwt_debug "Block level : %a" Raw_level.pp level >>= fun () ->
|
||||||
|
let chain = `Hash chain_id in
|
||||||
|
let block = `Hash (hash, 0) in
|
||||||
|
state.highest_level_encountered <- Raw_level.max level state.highest_level_encountered ;
|
||||||
|
(* Processing blocks *)
|
||||||
|
begin
|
||||||
|
Alpha_block_services.info cctxt ~chain ~block () >>= function
|
||||||
|
| Ok block_info ->
|
||||||
|
process_block cctxt state ~chain block_info
|
||||||
|
| Error errs ->
|
||||||
|
lwt_log_error "Error while fetching operations in block %a@\n%a"
|
||||||
|
Block_hash.pp_short hash
|
||||||
pp_print_error errs >>= fun () ->
|
pp_print_error errs >>= fun () ->
|
||||||
return ()
|
return ()
|
||||||
|
end >>=? fun () ->
|
||||||
|
(* Processing endorsements *)
|
||||||
|
begin Alpha_block_services.Operations.operations cctxt ~chain ~block () >>= function
|
||||||
|
| Ok operations ->
|
||||||
|
if List.length operations > endorsements_index then
|
||||||
|
let endorsements = List.nth operations endorsements_index in
|
||||||
|
process_endorsements cctxt state ~chain endorsements level
|
||||||
|
else return ()
|
||||||
|
| Error errs ->
|
||||||
|
lwt_log_error "Error while fetching operations in block %a@\n%a"
|
||||||
|
Block_hash.pp_short hash
|
||||||
|
pp_print_error errs >>= fun () ->
|
||||||
|
return ()
|
||||||
|
end >>=? fun () ->
|
||||||
|
cleanup_old_operations state >>= fun () ->
|
||||||
|
return ()
|
||||||
|
|
||||||
|
let create (cctxt : #Proto_alpha.full) ~preserved_levels valid_blocks_stream =
|
||||||
|
|
||||||
|
let process_block cctxt state bi =
|
||||||
|
process_new_block cctxt state bi >>= function
|
||||||
|
| Ok () ->
|
||||||
|
lwt_log_notice
|
||||||
|
"Block %a registered"
|
||||||
|
Block_hash.pp_short bi.Client_baking_blocks.hash
|
||||||
|
>>= return
|
||||||
|
| Error errs ->
|
||||||
|
lwt_log_error "Error while processing block %a@\n%a"
|
||||||
|
Block_hash.pp_short bi.hash
|
||||||
|
pp_print_error errs
|
||||||
|
>>= return
|
||||||
|
in
|
||||||
|
|
||||||
|
let state_maker _ _ =
|
||||||
|
create_state ~preserved_levels >>= return
|
||||||
in
|
in
|
||||||
|
|
||||||
Client_baking_scheduling.main
|
Client_baking_scheduling.main
|
||||||
~name:"denunciator"
|
~name:"accuser"
|
||||||
~cctxt
|
~cctxt
|
||||||
~stream:endorsement_stream
|
~stream:valid_blocks_stream
|
||||||
~state_maker:(fun _ _ -> return ())
|
~state_maker
|
||||||
~pre_loop:(fun _ _ _ -> return ())
|
~pre_loop:(fun _ _ _ -> return ())
|
||||||
~compute_timeout:(fun () -> never_ends)
|
~compute_timeout:(fun _ -> Lwt_utils.never_ending ())
|
||||||
~timeout_k:(fun _ _ () -> return ())
|
~timeout_k:(fun _ _ () -> return ())
|
||||||
~event_k
|
~event_k:process_block
|
||||||
|
|
||||||
|
@ -9,5 +9,6 @@
|
|||||||
|
|
||||||
val create:
|
val create:
|
||||||
#Proto_alpha.full ->
|
#Proto_alpha.full ->
|
||||||
Client_baking_operations.valid_endorsement tzresult Lwt_stream.t ->
|
preserved_levels: int ->
|
||||||
|
Client_baking_blocks.block_info tzresult Lwt_stream.t ->
|
||||||
unit tzresult Lwt.t
|
unit tzresult Lwt.t
|
||||||
|
@ -15,7 +15,6 @@ type operation = {
|
|||||||
content: Operation.packed option
|
content: Operation.packed option
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
type valid_endorsement = {
|
type valid_endorsement = {
|
||||||
hash: Operation_hash.t ;
|
hash: Operation_hash.t ;
|
||||||
source: public_key_hash ;
|
source: public_key_hash ;
|
||||||
|
@ -32,10 +32,9 @@ end
|
|||||||
|
|
||||||
module Accuser = struct
|
module Accuser = struct
|
||||||
|
|
||||||
let run (cctxt : #Proto_alpha.full) =
|
let run (cctxt : #Proto_alpha.full) ~preserved_levels =
|
||||||
Client_baking_operations.monitor_endorsement
|
Client_baking_blocks.monitor_valid_blocks cctxt ~chains:[ `Main ] () >>=? fun valid_blocks_stream ->
|
||||||
cctxt >>=? fun endorsement_stream ->
|
Client_baking_denunciation.create cctxt ~preserved_levels valid_blocks_stream >>=? fun () ->
|
||||||
Client_baking_denunciation.create cctxt endorsement_stream >>=? fun () ->
|
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
end
|
end
|
||||||
|
@ -30,5 +30,7 @@ end
|
|||||||
|
|
||||||
module Accuser : sig
|
module Accuser : sig
|
||||||
val run:
|
val run:
|
||||||
#Proto_alpha.full -> unit tzresult Lwt.t
|
#Proto_alpha.full ->
|
||||||
|
preserved_levels: int ->
|
||||||
|
unit tzresult Lwt.t
|
||||||
end
|
end
|
||||||
|
@ -106,8 +106,9 @@ let accuser_commands () =
|
|||||||
in
|
in
|
||||||
[
|
[
|
||||||
command ~group ~desc: "Launch the accuser daemon"
|
command ~group ~desc: "Launch the accuser daemon"
|
||||||
no_options
|
(args1 preserved_levels_arg)
|
||||||
(prefixes [ "run" ]
|
(prefixes [ "run" ]
|
||||||
@@ stop)
|
@@ stop)
|
||||||
(fun () cctxt -> Client_daemon.Accuser.run cctxt) ;
|
(fun preserved_levels cctxt ->
|
||||||
|
Client_daemon.Accuser.run ~preserved_levels cctxt) ;
|
||||||
]
|
]
|
||||||
|
Loading…
Reference in New Issue
Block a user