Error log in notification

dune-project

@@ -1,5 +1,7 @@
-(lang dune 2.5)
+(lang dune 2.7)
 (implicit_transitive_deps false)
 
 (formatting
  (enabled_for ocaml reason))
+
+(cram enable)

lib/action.ml

@@ -329,6 +329,31 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) (Buildkite_api :
     | Some sender_login -> List.exists (String.equal sender_login) cfg.ignored_users
     | None -> false
 
+  let get_job_log_name_and_content ~ctx n (job : Buildkite_t.job) =
+    Lwt_result.map
+      (fun (job_log : Buildkite_t.job_log) -> job.name, job_log.content)
+      (Buildkite_api.get_job_log ~ctx n job)
+
+  let get_logs ~ctx (n : status_notification) =
+    match%lwt Buildkite_api.get_build ~ctx n with
+    | Error e -> Lwt.return_error e
+    | Ok build ->
+      let failed_jobs = Util.Build.filter_failed_jobs build.jobs in
+      let%lwt logs_or_errors = Lwt_list.map_p (get_job_log_name_and_content ~ctx n) failed_jobs in
+      Lwt.return_ok
+      @@ List.filter_map
+           (function
+             | Ok content -> Some content
+             | Error e ->
+               log#warn "failed to get log content for job: %s" e;
+               None)
+           logs_or_errors
+
+  let get_logs_if_failed ~ctx (n : status_notification) =
+    match n.state with
+    | Success | Pending -> Lwt.return_ok []
+    | Failure | Error -> get_logs ~ctx n
+
   let generate_notifications (ctx : Context.t) (req : Github.t) =
     let repo = Github.repo_of_notification req in
     let cfg = Context.find_repo_config_exn ctx repo.url in
@@ -377,13 +402,27 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) (Buildkite_api :
           let%lwt failed_steps = Util.Build.new_failed_steps ~get_build:(Buildkite_api.get_build ~ctx) n repo_state in
           Lwt.return_some failed_steps
       in
-      let notifs = List.map (generate_status_notification ?slack_user_id ?failed_steps cfg n) channels in
+      let%lwt job_log =
+        match%lwt get_logs_if_failed ~ctx n with
+        | Error e ->
+          log#warn "couldn't fetch logs for build: %s" e;
+          Lwt.return []
+        | Ok job_log -> Lwt.return job_log
+      in
+      let notifs = List.map (generate_status_notification ?slack_user_id ~job_log ?failed_steps cfg n) channels in
       Lwt.return notifs
 
   let send_notifications (ctx : Context.t) notifications =
-    let notify (msg, handler) =
+    let notify_reply msg ts reply =
+      let msg = message_of_reply ~msg ~ts reply in
+      match%lwt Slack_api.send_notification ~ctx ~msg with
+      | Ok _ -> Lwt.return_unit
+      | Error e -> action_error e
+    in
+    let notify (msg, handler, replies) =
       match%lwt Slack_api.send_notification ~ctx ~msg with
       | Ok (Some res) ->
+        let%lwt () = Lwt_list.iter_s (notify_reply msg res.ts) replies in
         (match handler with
         | None -> Lwt.return_unit
         | Some handler ->

lib/api.ml

@@ -39,6 +39,8 @@ module type Slack = sig
 end
 
 module type Buildkite = sig
+  val get_job_log :
+    ctx:Context.t -> Github_t.status_notification -> Buildkite_t.job -> (Buildkite_t.job_log, string) result Lwt.t
   val get_build_branch : ctx:Context.t -> Github_t.status_notification -> (Github_t.branch, string) Result.t Lwt.t
 
   val get_build :

lib/api_local.ml

@@ -78,7 +78,9 @@ module Slack : Api.Slack = struct
     let json = msg |> Slack_j.string_of_post_message_req |> Yojson.Basic.from_string |> Yojson.Basic.pretty_to_string in
     Printf.printf "will notify #%s\n" (Slack_channel.Any.project msg.channel);
     Printf.printf "%s\n" json;
-    Lwt.return @@ Ok None
+    let channel = Slack_channel.Ident.inject (Slack_channel.Any.project msg.channel) in
+    let res = { Slack_t.channel; ts = Slack_timestamp.inject "mock_ts" } in
+    Lwt.return @@ Ok (Some res)
 
   let send_chat_unfurl ~ctx:_ ~channel ~ts ~unfurls () =
     let req = Slack_j.{ channel; ts; unfurls } in
@@ -113,7 +115,9 @@ module Slack_simple : Api.Slack = struct
       (match msg.Slack_t.text with
       | None -> ""
       | Some s -> sprintf " with %S" s);
-    Lwt.return @@ Ok None
+    let channel = Slack_channel.Ident.inject (Slack_channel.Any.project msg.channel) in
+    let res = { Slack_t.channel; ts = Slack_timestamp.inject "mock_ts" } in
+    Lwt.return @@ Ok (Some res)
 
   let send_chat_unfurl ~ctx:_ ~channel ~ts:_ ~(unfurls : Slack_t.message_attachment Common.StringMap.t) () =
     Printf.printf "will unfurl in #%s\n" (Slack_channel.Ident.project channel);
@@ -145,7 +149,9 @@ module Slack_json : Api.Slack = struct
     let url = Uri.add_query_param url ("msg", [ json ]) in
     log#info "%s" (Uri.to_string url);
     log#info "%s" json;
-    Lwt.return_ok None
+    let channel = Slack_channel.Ident.inject (Slack_channel.Any.project msg.channel) in
+    let res = { Slack_t.channel; ts = Slack_timestamp.inject "mock_ts" } in
+    Lwt.return_ok (Some res)
 
   let send_chat_unfurl ~ctx:_ ~channel ~ts:_ ~(unfurls : Slack_t.message_attachment Common.StringMap.t) () =
     log#info "will notify %s" (Slack_channel.Ident.project channel);
@@ -164,6 +170,21 @@ module Slack_json : Api.Slack = struct
 end
 
 module Buildkite : Api.Buildkite = struct
+  let get_job_log ~ctx:_ (_ : Github_t.status_notification) (job : Buildkite_t.job) =
+    match job.log_url with
+    | None -> Lwt.return_error "Unable to get job log, job has no log_url field"
+    | Some log_url ->
+    match Re2.find_submatches_exn Util.Build.buildkite_api_org_pipeline_build_job_re log_url with
+    | exception exn -> Exn.fail ~exn "failed to parse buildkite build url %s" log_url
+    | [| Some _; Some org; Some pipeline; Some build_nr; Some job_nbr |] ->
+      let file =
+        clean_forward_slashes
+          (sprintf "organizations/%s/pipelines/%s/builds/%s/jobs/%s/logs" org pipeline build_nr job_nbr)
+      in
+      let url = Filename.concat buildkite_cache_dir file in
+      with_cache_file url Buildkite_j.job_log_of_string
+    | _ -> failwith "failed to get all job log details from the job."
+
   let get_build' (n : Github_t.status_notification) read =
     match n.target_url with
     | None -> Lwt.return_error "no build url. Is this a Buildkite notification?"

lib/api_remote.ml

@@ -141,7 +141,7 @@ module Slack : Api.Slack = struct
         (sprintf "users.lookupByEmail?%s" url_args)
         Slack_j.read_lookup_user_res
     with
-    | Error _ as e -> Lwt.return e
+    | Error e -> Lwt.return_error e
     | Ok user ->
       Hashtbl.replace lookup_user_cache email user;
       Lwt.return_ok user
@@ -257,6 +257,13 @@ module Buildkite : Api.Buildkite = struct
       | Ok res -> Lwt.return @@ Ok res
       | Error e -> Lwt.return @@ fmt_error "%s: failure : %s" name e)
 
+  let get_job_log ~ctx n (job : Buildkite_t.job) =
+    match Util.Build.get_org_pipeline_build n with
+    | Error e -> Lwt.return_error e
+    | Ok (org, pipeline, build_nr) ->
+      let url = sprintf "organizations/%s/pipelines/%s/builds/%s/jobs/%s/log" org pipeline build_nr job.id in
+      request_token_auth ~name:"get buildkite job logs" ~ctx `GET url Buildkite_j.job_log_of_string
+
   let get_build' ~ctx ~org ~pipeline ~build_nr map =
     let build_url = sprintf "organizations/%s/pipelines/%s/builds/%s" org pipeline build_nr in
     match%lwt request_token_auth ~name:"get build details" ~ctx `GET build_url Buildkite_j.get_build_res_of_string with

lib/buildkite.atd

@@ -1,24 +1,61 @@
 (* We keep this type an open enum because buildkite's documentation is not up to date and might have
    more states. It shouldn't be an issue because we don't care about all the possible states. *)
-type build_state = [
+   type build_state = [
+    | Blocked <json name="blocked">
+    | Canceled <json name="canceled">
+    | Canceling <json name="canceling">
+    | Failed <json name="failed">
+    | Failing <json name="failing">
+    | Finished <json name="finished">
+    | Not_run <json name="not_run">
+    | Passed <json name="passed">
+    | Running <json name="running">
+    | Scheduled <json name="scheduled">
+    | Skipped <json name="skipped">
+    | Other of string
+  ] <json open_enum> <ocaml repr="classic">
+
+
+type job_state = [
+  | Pending <json name="pending">
+  | Waiting <json name="waiting">
+  | Waiting_failed <json name="waiting_failed">
   | Blocked <json name="blocked">
-  | Canceled <json name="canceled">
-  | Canceling <json name="canceling">
-  | Failed <json name="failed">
-  | Failing <json name="failing">
-  | Finished <json name="finished">
-  | Not_run <json name="not_run">
-  | Passed <json name="passed">
-  | Running <json name="running">
+  | Blocked_failed <json name="blocked_failed">
+  | Unblocked <json name="unblocked">
+  | Unblocked_failed <json name="unblocked_failed">
+  | Limiting <json name="limiting">
+  | Limited <json name="limited">
   | Scheduled <json name="scheduled">
+  | Assigned <json name="assigned">
+  | Accepted <json name="accepted">
+  | Running <json name="running">
+  | Finished <json name="finished">
+  | Canceling <json name="canceling">
+  | Canceled <json name="canceled">
+  | Expired <json name="expired">
+  | Timing_out <json name="timing_out">
+  | Timed_out <json name="timed_out">
   | Skipped <json name="skipped">
+  | Broken <json name="broken">
+  | Passed <json name="passed">
+  | Failed <json name="failed">
   | Other of string
 ] <json open_enum> <ocaml repr="classic">
 
-type job = {
-  name: string;
-  state: build_state;
-  web_url: string;
+type job_log = {
+  url: string;
+  content: string;
+  size: int
+}
+
+type job =  {
+  id : string;
+  ?log_url: string option;
+  name : string;
+  type_ <json name="type"> : string;
+  state : job_state;
+  web_url : string;
 }
 
 type non_job = {
@@ -46,3 +83,11 @@ type failed_step = {
   name: string;
   build_url: string;
 }
+
+type get_build_response = {
+  number: int;
+  branch: string;
+  jobs: job list;
+  url: string;
+  (* There are more fields, but we don't need/want them for now *)
+}

lib/dune

@@ -19,7 +19,8 @@
   re2
   sexplib0
   uri
-  yojson)
+  yojson
+  text_cleanup)
  (preprocess
   (pps lwt_ppx)))
 

lib/slack.ml

@@ -45,7 +45,17 @@ let markdown_text_attachment ~footer markdown_body =
     };
   ]
 
-let make_message ?username ?text ?attachments ?blocks ?thread ?handler ?(reply_broadcast = false) ~channel () =
+type msg_reply = {
+  text : string option;
+  attachments : message_attachment list option;
+  blocks : message_block list option;
+  reply_broadcast : bool;
+}
+
+let make_reply ?text ?attachments ?blocks ?(reply_broadcast = false) () = { text; attachments; blocks; reply_broadcast }
+
+let make_message ?username ?text ?attachments ?blocks ?thread ?handler ?(reply_broadcast = false) ?(replies = [])
+  ~channel () =
   ( {
       channel;
       thread_ts = Option.map (fun (t : State_t.slack_thread) -> t.ts) thread;
@@ -57,7 +67,21 @@ let make_message ?username ?text ?attachments ?blocks ?thread ?handler ?(reply_b
       unfurl_media = None;
       reply_broadcast;
     },
-    handler )
+    handler,
+    replies )
+
+let message_of_reply ~(msg : post_message_req) ~ts ({ text; attachments; blocks; reply_broadcast } : msg_reply) =
+  {
+    channel = msg.channel;
+    thread_ts = Some ts;
+    text;
+    attachments;
+    blocks;
+    username = msg.username;
+    unfurl_links = Some false;
+    unfurl_media = None;
+    reply_broadcast;
+  }
 
 let github_handle_regex = Re2.create_exn {|\B@([[:alnum:]][[:alnum:]-]{1,38})\b|}
 (* Match GH handles in messages - a GitHub handle has at most 39 chars and no underscore *)
@@ -308,8 +332,8 @@ let generate_push_notification notification channel =
 
 let buildkite_description_re = Re2.create_exn {|^Build #(\d+)(.*)|}
 
-let generate_status_notification ?slack_user_id ?failed_steps (cfg : Config_t.config) (n : status_notification) channel
-    =
+let generate_status_notification ?slack_user_id ?failed_steps ~(job_log : (string * string) list)
+  (cfg : Config_t.config) (n : status_notification) channel =
   let { commit; state; description; target_url; context; repository; _ } = n in
   let ({ commit : inner_commit; sha; html_url; _ } : status_commit) = commit in
   let ({ message; author; _ } : inner_commit) = commit in
@@ -412,7 +436,34 @@ let generate_status_notification ?slack_user_id ?failed_steps (cfg : Config_t.co
         failed_steps
   in
   let attachment = { empty_attachments with mrkdwn_in = Some [ "fields"; "text" ]; color = Some color_info; text } in
-  make_message ~text:summary ~attachments:[ attachment ] ~channel:(Status_notification.to_slack_channel channel) ()
+  let reply_of_log log =
+    log
+    |> Text_cleanup.cleanup
+    |> String.split_on_char '\r'
+    |> String.concat "\n"
+    |> String.split_on_char '\n'
+    |> List.rev
+    |> List.to_seq
+    |> Seq.filter (( <> ) "")
+    |> Seq.take 15
+    |> List.of_seq
+    |> List.rev
+    |> String.concat "\n"
+  in
+  let replies =
+    match job_log with
+    | [] -> []
+    | _ :: _ ->
+      let text =
+        job_log
+        |> List.map (fun (job_name, job_log) -> sprintf "Log for %s: ```\n%s```" job_name (reply_of_log job_log))
+        |> String.concat "\n"
+      in
+      [ make_reply ~text () ]
+  in
+  make_message ~text:summary ~attachments:[ attachment ]
+    ~channel:(Status_notification.to_slack_channel channel)
+    ~replies ()
 
 let generate_commit_comment_notification ~slack_match_func api_commit notification channel =
   let { commit; _ } = api_commit in

lib/text_cleanup/dune

@@ -0,0 +1,4 @@
+(library
+ (name text_cleanup))
+
+(ocamllex lexer)

lib/text_cleanup/lexer.mll

@@ -0,0 +1,16 @@
+{}
+
+let digit = ['0' - '9']
+
+let esc = '\027'
+
+let timestamp = esc "_bk;t=" digit* '\007'
+
+let color_code = esc '[' (digit | ';') * 'm'
+
+let to_delete = timestamp | color_code
+
+rule cleanup buf = parse
+| to_delete { cleanup buf lexbuf }
+| _ { Buffer.add_string buf (Lexing.lexeme lexbuf); cleanup buf lexbuf }
+| eof { () }

lib/text_cleanup/test/dune

@@ -0,0 +1 @@
+(cram (deps %{bin:text_cleanup}))