balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Alpha/Accuser: add a new accuser adapted to the new daemon framework

Browse Source
This commit is contained in:
Vincent Botbol 2018-06-25 16:40:49 +02:00
parent aa95ee8332
commit b2194fa27d
9 changed files with 255 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/proto_alpha/lib_client/client_proto_args.ml
View File

@ -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_fee_threshold of string
type error += Bad_endorsement_delay of string
type error += Bad_preserved_levels of string
let () =
register_error_kind
@ -60,7 +61,17 @@ let () =
Format.fprintf ppf "Bad argument value for -endorsement-delay. Expected an integer, but given '%s'" literal)
Data_encoding.(obj1 (req "parameter" string))
(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 =
@ -218,6 +229,21 @@ let endorsement_delay_arg =
try return (int_of_string 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 =
switch
~long:"no-print-source"

1
src/proto_alpha/lib_client/client_proto_args.mli
View File

@ -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 minimal_timestamp_switch: (bool, 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_confirmation: (bool, Proto_alpha.full) Clic.arg

2
src/proto_alpha/lib_delegate/client_baking_blocks.ml
View File

@ -45,7 +45,7 @@ let info cctxt ?(chain = `Main) block =
raw_info cctxt ~chain hash shell_header
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) ->
return (Lwt_stream.map_s
(fun ((chain, block), { Tezos_base.Block_header.shell }) ->

239
src/proto_alpha/lib_delegate/client_baking_denunciation.ml
View File

@ -9,37 +9,226 @@
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 =
(* TODO: more than just logging *)
Client_keys.Public_key_hash.name
cctxt
e.Client_baking_operations.source >>= function
| Ok source ->
lwt_debug
"Discovered endorsement for block %a by %s (slot @[<h>%a@])"
Block_hash.pp_short e.block
source
Format.(pp_print_list pp_print_int) e.slots >>= fun () ->
return ()
module HLevel = Hashtbl.Make(struct
include Raw_level
let hash lvl = Int32.to_int (to_int32 lvl)
end)
module Delegate_Map = Map.Make(Signature.Public_key_hash)
type state = {
(* Endorsements seen so far *)
endorsements_table : Kind.endorsement operation Delegate_Map.t HLevel.t ;
(* Blocks received so far *)
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 ->
lwt_log_error "Bad preserved_levels conversion : %a" pp_print_error errs >>=
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 *)
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 () ->
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 whilst checking the endorsment %a/%a:@\n%a"
Block_hash.pp_short e.block
Format.(pp_print_list pp_print_int) e.slots
pp_print_error errs >>= fun () ->
return ()
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
Client_baking_scheduling.main
~name:"denunciator"
~name:"accuser"
~cctxt
~stream:endorsement_stream
~state_maker:(fun _ _ -> return ())
~stream:valid_blocks_stream
~state_maker
~pre_loop:(fun _ _ _ -> return ())
~compute_timeout:(fun () -> never_ends)
~compute_timeout:(fun _ -> Lwt_utils.never_ending ())
~timeout_k:(fun _ _ () -> return ())
~event_k
~event_k:process_block

3
src/proto_alpha/lib_delegate/client_baking_denunciation.mli
View File

@ -9,5 +9,6 @@
val create:
#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

1
src/proto_alpha/lib_delegate/client_baking_operations.ml
View File

@ -15,7 +15,6 @@ type operation = {
content: Operation.packed option
}
type valid_endorsement = {
hash: Operation_hash.t ;
source: public_key_hash ;

7
src/proto_alpha/lib_delegate/client_daemon.ml
View File

@ -32,10 +32,9 @@ end
module Accuser = struct
let run (cctxt : #Proto_alpha.full) =
Client_baking_operations.monitor_endorsement
cctxt >>=? fun endorsement_stream ->
Client_baking_denunciation.create cctxt endorsement_stream >>=? fun () ->
let run (cctxt : #Proto_alpha.full) ~preserved_levels =
Client_baking_blocks.monitor_valid_blocks cctxt ~chains:[ `Main ] () >>=? fun valid_blocks_stream ->
Client_baking_denunciation.create cctxt ~preserved_levels valid_blocks_stream >>=? fun () ->
return ()
end

4
src/proto_alpha/lib_delegate/client_daemon.mli
View File

@ -30,5 +30,7 @@ end
module Accuser : sig
val run:
#Proto_alpha.full -> unit tzresult Lwt.t
#Proto_alpha.full ->
preserved_levels: int ->
unit tzresult Lwt.t
end

7
src/proto_alpha/lib_delegate/delegate_commands.ml
View File

@ -87,7 +87,7 @@ let endorser_commands () =
in
[
command ~group ~desc: "Launch the endorser daemon"
(args1 endorsement_delay_arg )
(args1 endorsement_delay_arg)
(prefixes [ "run" ]
@@ seq_of_param Client_keys.Public_key_hash.alias_param)
(fun endorsement_delay delegates cctxt ->
@ -106,8 +106,9 @@ let accuser_commands () =
in
[
command ~group ~desc: "Launch the accuser daemon"
no_options
(args1 preserved_levels_arg)
(prefixes [ "run" ]
@@ stop)
(fun () cctxt -> Client_daemon.Accuser.run cctxt) ;
(fun preserved_levels cctxt ->
Client_daemon.Accuser.run ~preserved_levels cctxt) ;
]