Baker: log included operations on block injection failure

src/proto_alpha/lib_delegate/client_baking_forge.ml

@@ -467,7 +467,7 @@ let filter_and_apply_operations
     add_operation inc op >>= function
     | Error errs ->
         lwt_debug Tag.DSL.(fun f ->
-            f "Client-side validation: invalid operation filtered %a\n@[<v 4>%a@]"
+            f "@[<v 4>Client-side validation: invalid operation filtered %a@\n%a@]"
             -% t event "baking_rejected_invalid_operation"
             -% a Operation_hash.Logging.tag (Operation.hash_packed op)
             -% a errs_tag errs)
@@ -672,7 +672,16 @@ let forge_block
 
   inject_block cctxt
     ?force ~chain ~shell_header ~priority ?seed_nonce_hash ~src_sk
-    operations
+    operations >>= function
+  | Ok hash -> return hash
+  | Error errs as error ->
+      lwt_log_error Tag.DSL.(fun f ->
+          f "@[<v 4>Error while injecting block@ @[Included operations : %a@]@ %a@]"
+          -% t event "block_injection_failed"
+          -% a raw_operations_tag (List.concat operations)
+          -% a errs_tag errs
+        ) >>= fun () ->
+      Lwt.return error
 
 let shell_prevalidation
     (cctxt : #Proto_alpha.full)
@@ -965,26 +974,33 @@ let bake (cctxt : #Proto_alpha.full) state =
           State.record cctxt src_pkh level >>=? fun () ->
 
           inject_block cctxt ~chain ~force:true
-            ~shell_header ~priority ?seed_nonce_hash ~src_sk operations
-          |> trace_exn (Failure "Error while injecting block") >>=? fun block_hash ->
+            ~shell_header ~priority ?seed_nonce_hash ~src_sk operations >>= function
+          | Error errs ->
+              lwt_log_error Tag.DSL.(fun f ->
+                  f "@[<v 4>Error while injecting block@ @[Included operations : %a@]@ %a@]"
+                  -% t event "block_injection_failed"
+                  -% a raw_operations_tag (List.concat operations)
+                  -% a errs_tag errs
+                ) >>= fun () -> return_unit
 
-          lwt_log_notice Tag.DSL.(fun f ->
-              f "Injected block %a for %s after %a (level %a, priority %d, fitness %a, operations %a)."
-              -% t event "injected_block"
-              -% a Block_hash.Logging.tag block_hash
-              -% s Client_keys.Logging.tag name
-              -% a Block_hash.Logging.tag shell_header.predecessor
-              -% a level_tag level
-              -% s bake_priority_tag priority
-              -% a fitness_tag shell_header.fitness
-              -% a operations_tag operations
-            ) >>= fun () ->
+          | Ok block_hash ->
+              lwt_log_notice Tag.DSL.(fun f ->
+                  f "Injected block %a for %s after %a (level %a, priority %d, fitness %a, operations %a)."
+                  -% t event "injected_block"
+                  -% a Block_hash.Logging.tag block_hash
+                  -% s Client_keys.Logging.tag name
+                  -% a Block_hash.Logging.tag shell_header.predecessor
+                  -% a level_tag level
+                  -% s bake_priority_tag priority
+                  -% a fitness_tag shell_header.fitness
+                  -% a operations_tag operations
+                ) >>= fun () ->
 
-          begin if seed_nonce_hash <> None then
-              Client_baking_nonces.add cctxt block_hash seed_nonce
-              |> trace_exn (Failure "Error while recording nonce")
-            else return_unit end >>=? fun () ->
-          return_unit
+              begin if seed_nonce_hash <> None then
+                  Client_baking_nonces.add cctxt block_hash seed_nonce
+                  |> trace_exn (Failure "Error while recording nonce")
+                else return_unit end >>=? fun () ->
+              return_unit
     end
   | None -> (* Error while building a block *)
       lwt_log_error Tag.DSL.(fun f ->

src/proto_alpha/lib_delegate/logging.ml

@@ -40,6 +40,14 @@ let operations_tag = Tag.def ~doc:"Block Operations" "operations"
        ~pp_sep:(fun ppf () -> Format.fprintf ppf "+")
        (fun ppf operations -> Format.fprintf ppf "%d" (List.length operations)))
 
+let raw_operations_tag = Tag.def ~doc:"Raw operations" "raw_operations"
+    (fun fmt raw_ops ->
+       let pp_op fmt op =
+         let json = Data_encoding.Json.construct Operation.raw_encoding op in
+         Format.fprintf fmt "%a" Data_encoding.Json.pp json
+       in
+       Format.fprintf fmt "@[<v>%a@]" (Format.pp_print_list ~pp_sep:Format.pp_print_cut pp_op) raw_ops)
+
 let bake_op_count_tag = Tag.def ~doc:"Bake Operation Count" "operation_count" Format.pp_print_int
 
 let endorsement_slot_tag = Tag.def ~doc:"Endorsement Slot" "endorsement_slot" Format.pp_print_int

src/proto_alpha/lib_delegate/logging.mli

@@ -33,6 +33,7 @@ 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 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
 val endorsement_slots_tag : int list Tag.def