More logging for the client daemons

- log seen blocks and heads when monitoring
- more detailed logging for baked blocks
- more detailed logging for endorsements
- more detailed logging for denunciations
- more detailed logging for nonce revelations

src/proto_alpha/lib_delegate/client_baking_blocks.ml

@@ -25,6 +25,9 @@
 
 open Proto_alpha
 open Alpha_context
+open Logging
+
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "client.blocks" end)
 
 type block_info = {
   hash: Block_hash.t ;
@@ -65,15 +68,27 @@ let monitor_valid_blocks cctxt ?chains ?protocols ~next_protocols () =
   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 }) ->
+            (fun ((chain, block), data) ->
-               raw_info cctxt ~chain:(`Hash chain) block shell)
+               log_info Tag.DSL.(fun f ->
+                   f "Saw block %a on chain %a"
+                   -% t event "monitor_saw_valid_block"
+                   -% a Block_hash.Logging.tag block
+                   -% a State_logging.chain_id chain
+                   -% t block_header_tag data) ;
+               raw_info cctxt ~chain:(`Hash chain) block data.Tezos_base.Block_header.shell)
             block_stream)
 
 let monitor_heads cctxt ~next_protocols chain =
   Monitor_services.heads
     cctxt ?next_protocols chain >>=? fun (block_stream, _stop) ->
   return (Lwt_stream.map_s
-            (fun (block, { Tezos_base.Block_header.shell }) -> raw_info cctxt ~chain block shell)
+            (fun (block, data) ->
+               log_info Tag.DSL.(fun f ->
+                   f "Saw head %a"
+                   -% t event "monitor_saw_head"
+                   -% a Block_hash.Logging.tag block
+                   -% t block_header_tag data) ;
+               raw_info cctxt ~chain block data.Tezos_base.Block_header.shell)
             block_stream)
 
 let blocks_from_current_cycle cctxt ?(chain = `Main) block ?(offset = 0l) () =

src/proto_alpha/lib_delegate/client_baking_denunciation.ml

@@ -113,6 +113,7 @@ let process_endorsements (cctxt : #Proto_alpha.full) state ~chain
                 lwt_log_notice Tag.DSL.(fun f ->
                     f "Double endorsement evidence injected %a"
                     -% t event "double_endorsement_denounced"
+                    -% t signed_operation_tag bytes
                     -% a Operation_hash.Logging.tag op_hash) >>= fun () ->
                 return @@ HLevel.replace state.endorsements_table level
                   (Delegate_Map.add delegate new_endorsement map)
@@ -166,6 +167,7 @@ let process_block (cctxt : #Proto_alpha.full) state ~chain (header : Alpha_block
         lwt_log_notice Tag.DSL.(fun f ->
             f "Double baking evidence injected %a"
             -% t event "double_baking_denounced"
+            -% t signed_operation_tag bytes
             -% a Operation_hash.Logging.tag op_hash) >>= fun () ->
         return @@ HLevel.replace state.blocks_table level
           (Delegate_Map.add baker hash map)

src/proto_alpha/lib_delegate/client_baking_endorsement.ml

@@ -137,6 +137,7 @@ let endorse_for_delegate cctxt block delegate =
       -% a Block_hash.Logging.tag hash
       -% a level_tag level
       -% s Client_keys.Logging.tag name
+      -% t Signature.Public_key_hash.Logging.tag delegate
       -% a Operation_hash.Logging.tag oph) >>= fun () ->
   return_unit
 

src/proto_alpha/lib_delegate/client_baking_forge.ml

@@ -150,6 +150,12 @@ let inject_block
     src_sk shell_header priority seed_nonce_hash >>=? fun signed_header ->
   Shell_services.Injection.block cctxt
     ?force ~chain signed_header operations >>=? fun block_hash ->
+  lwt_log_info Tag.DSL.(fun f ->
+      f "Client_baking_forge.inject_block: inject %a"
+      -% t event "inject_baked_block"
+      -% a Block_hash.Logging.tag block_hash
+      -% t signed_header_tag signed_header
+      -% t operations_tag operations) >>= fun () ->
   return block_hash
 
 type error += Failed_to_preapply of Tezos_base.Operation.t * error list

src/proto_alpha/lib_delegate/client_baking_revelation.ml

@@ -34,7 +34,16 @@ let inject_seed_nonce_revelation rpc_config ?(chain = `Main) block ?async nonces
        Alpha_services.Forge.seed_nonce_revelation rpc_config
          (chain, block) ~branch ~level ~nonce () >>=? fun bytes ->
        let bytes = Signature.concat bytes Signature.zero in
-       Shell_services.Injection.operation rpc_config ?async ~chain bytes)
+       Shell_services.Injection.operation rpc_config ?async ~chain bytes >>=? fun oph ->
+       lwt_debug Tag.DSL.(fun f ->
+           f "Revealing nonce %a from level %a at chain %a, block %a with operation %a"
+           -% t event "reveal_nonce"
+           -% a Logging.nonce_tag nonce
+           -% a Logging.level_tag level
+           -% a Logging.chain_tag chain
+           -% a Logging.block_tag block
+           -% a Operation_hash.Logging.tag oph) >>= fun () ->
+       return oph)
     nonces >>=? fun ophs ->
   return ophs
 

src/proto_alpha/lib_delegate/logging.ml

@@ -35,6 +35,8 @@ let current_slots_tag = Tag.def ~doc:"Number of baking slots that can be baked a
 let future_slots_tag = Tag.def ~doc:"Number of baking slots in the foreseeable future but not yet bakeable" "future_slots" Format.pp_print_int
 let timespan_tag = Tag.def ~doc:"Time in seconds" "timespan" (fun fmt i -> Format.fprintf fmt "%Lds" i)
 
+let signed_header_tag = Tag.def ~doc:"Signed header" "signed_header" MBytes.pp_hex
+let signed_operation_tag = Tag.def ~doc:"Signed operation" "signed_operation" MBytes.pp_hex
 let operations_tag = Tag.def ~doc:"Block Operations" "operations"
     (Format.pp_print_list
        ~pp_sep:(fun ppf () -> Format.fprintf ppf "+")
@@ -56,8 +58,13 @@ let denounced_endorsements_slots_tag = Tag.def ~doc:"Endorsement Slots" "denounc
 let denouncement_source_tag = Tag.def ~doc:"Denounce Source" "source" Format.pp_print_text
 
 let level_tag = Tag.def ~doc:"Level" "level" Raw_level.pp
+let nonce_tag = Tag.def ~doc:"Nonce" "nonce" Data_encoding.Json.(fun ppf nonce -> pp ppf (construct Nonce.encoding nonce))
+let chain_tag = Tag.def ~doc:"Chain selector" "chain" Format.(fun ppf chain -> pp_print_string ppf @@ Block_services.chain_to_string chain)
+let block_tag = Tag.def ~doc:"Block selector" "block" Format.(fun ppf block -> pp_print_string ppf @@ Block_services.to_string block)
 
 let worker_tag = Tag.def ~doc:"Worker in which event occurred" "worker" Format.pp_print_text
 
+let block_header_tag = Tag.def ~doc:"Raw block header" "block_header" (fun ppf _ -> Format.fprintf ppf "[raw block header]")
+
 let conflicting_endorsements_tag = Tag.def ~doc:"Two conflicting endorsements signed by the same key" "conflicting_endorsements" Format.(
     fun ppf (a,b) -> fprintf ppf "%a / %a" Operation_hash.pp (Operation.hash a) Operation_hash.pp (Operation.hash b))

src/proto_alpha/lib_delegate/logging.mli

@@ -32,7 +32,9 @@ val current_slots_tag : int Tag.def
 val future_slots_tag : int Tag.def
 val timespan_tag : int64 Tag.def
 
-val operations_tag : Proto_alpha.Alpha_context.Operation.raw list list Tag.def
+val signed_header_tag : MBytes.t Tag.def
+val signed_operation_tag : MBytes.t Tag.def
+val operations_tag : Tezos_base.Operation.t list list Tag.def
 val raw_operations_tag : Proto_alpha.Alpha_context.Operation.raw list Tag.def
 val bake_op_count_tag : int Tag.def
 val endorsement_slot_tag : int Tag.def
@@ -40,7 +42,11 @@ val endorsement_slots_tag : int list Tag.def
 val denounced_endorsements_slots_tag : int list Tag.def
 val denouncement_source_tag : string Tag.def
 val level_tag : Proto_alpha.Alpha_context.Raw_level.t Tag.def
+val nonce_tag : Proto_alpha.Alpha_context.Nonce.t Tag.def
+val chain_tag : Block_services.chain Tag.def
+val block_tag : Block_services.block Tag.def
 val worker_tag : string Tag.def
+val block_header_tag : Block_header.t Tag.def
 
 open Proto_alpha.Alpha_context
 val conflicting_endorsements_tag : (Kind.endorsement operation * Kind.endorsement operation) Tag.def